[svn-r27373] moved building generated test APIs to a sperated build program (was in fortran/src/H5_buildiface.F90)

1 files changed, 272 insertions, 0 deletions

diff --git a/fortran/test/H5_test_buildiface.F90 b/fortran/test/H5_test_buildiface.F90
new file mode 100644
index 0000000..fe5e716
--- /dev/null
+++ b/fortran/test/H5_test_buildiface.F90
@@ -0,0 +1,272 @@
+!****p* Program/H5_buildiface
+!
+! NAME
+!  Executable: H5_buildiface
+!
+! FILE
+!  fortran/src/H5_buildiface.f90
+!
+! PURPOSE
+!  This stand alone program is used at build time to generate the program
+!  H5fortran_detect.f90. It cycles through all the available KIND parameters for
+!  integers and reals. The appropriate program and subroutines are then generated
+!  depending on which of the KIND values are found.
+!
+! NOTES
+!  This program uses the Fortran 2008 intrinsic function STORAGE_SIZE or SIZEOF 
+!  depending on availablity.It generates code that makes use of 
+!  STORAGE_SIZE/SIZEOF in H5fortran_detect.f90. STORAGE_SIZE is standard
+!  compliant and should always be chosen over SIZEOF.
+!
+!  The availability of STORAGE_SIZE/SIZEOF is checked at configure time and the TRUE/FALSE
+!  condition is set in the configure variable "FORTRAN_HAVE_STORAGE_SIZE" or
+!  "FORTRAN_HAVE_SIZEOF".
+!
+!  The use of C_SIZOF(X) is not used since the argument X must be an interoperable
+!  data entity.
+!
+! COPYRIGHT
+!  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!  Copyright by The HDF Group.                                                 *
+!  Copyright by the Board of Trustees of the University of Illinois.           *
+!  All rights reserved.                                                        *
+!                                                                              *
+!  This file is part of HDF5.  The full HDF5 copyright notice, including       *
+!  terms governing use, modification, and redistribution, is contained in      *
+!  the files COPYING and Copyright.html.  COPYING can be found at the root     *
+!  of the source code distribution tree; Copyright.html can be found at the    *
+!  root level of an installed copy of the electronic HDF5 document set and     *
+!  is linked from the top-level documents page.  It can also be found at       *
+!  http://hdfgroup.org/HDF5/doc/Copyright.html.  If you do not have            *
+!  access to either file, you may request a copy from help@hdfgroup.org.       *
+!  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+! AUTHOR
+!  M. Scot Breitenfeld
+!
+!*****
+
+#include <H5config_f.inc>
+
+PROGRAM H5_test_buildiface
+  USE, INTRINSIC :: ISO_C_BINDING
+  IMPLICIT NONE
+
+! These values are valid REAL KINDs (with corresponding C float) found during configure
+  H5_H5CONFIG_F_NUM_RKIND
+  H5_H5CONFIG_F_RKIND
+! These values are valid INTEGER KINDs (with corresponding C float) found during configure
+  H5_H5CONFIG_F_NUM_IKIND
+  H5_H5CONFIG_F_IKIND
+
+  INTEGER :: i, j, k
+  INTEGER :: ji, jr, jd
+#ifdef H5_FORTRAN_HAVE_C_LONG_DOUBLE
+  REAL(KIND=C_LONG_DOUBLE) :: c_longdble
+#endif
+  REAL(KIND=C_DOUBLE) :: c_dble
+  REAL(KIND=C_FLOAT) :: c_flt
+  INTEGER :: sizeof_var
+  CHARACTER(LEN=2) :: chr2
+! subroutine rank of array being passed in
+  CHARACTER(LEN=2), DIMENSION(1:8), PARAMETER :: chr_rank=(/"_0","_1","_2","_3","_4","_5","_6","_7"/)
+! rank definitions
+  CHARACTER(LEN=70), DIMENSION(1:8), PARAMETER :: rank_dim_line=(/ &
+       '                                                                    ', &
+       ', DIMENSION(dims(1))                                                ', &
+       ', DIMENSION(dims(1),dims(2))                                        ', &
+       ', DIMENSION(dims(1),dims(2),dims(3))                                ', &
+       ', DIMENSION(dims(1),dims(2),dims(3),dims(4))                        ', &
+       ', DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5))                ', &
+       ', DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6))        ', &
+       ', DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7))' &
+            /)
+! pointer to the buffer
+  CHARACTER(LEN=37), DIMENSION(1:8), PARAMETER :: f_ptr_line=(/ &
+       '    f_ptr = C_LOC(buf)               ', &
+       '    f_ptr = C_LOC(buf(1))            ', &
+       '    f_ptr = C_LOC(buf(1,1))          ', &
+       '    f_ptr = C_LOC(buf(1,1,1))        ', &
+       '    f_ptr = C_LOC(buf(1,1,1,1))      ', &
+       '    f_ptr = C_LOC(buf(1,1,1,1,1))    ', &
+       '    f_ptr = C_LOC(buf(1,1,1,1,1,1))  ', &
+       '    f_ptr = C_LOC(buf(1,1,1,1,1,1,1))' &
+            /)
+
+
+
+! Generate Fortran Check routines for the tests KIND interfaces.
+
+  OPEN(11,FILE='tf_gen.F90')
+  WRITE(11,'(40(A,/))') &
+'!****h* ROBODoc/TH5_MISC_gen.F90',&
+'!',&
+'! NAME',&
+'!  TH5_MISC_gen',&
+'! ',&
+'! PURPOSE',&
+'!  This module is generated at build by H5_test_buildiface.F90 to handle checking ',&
+'!  in the tests all the detected KINDs.',&
+'!',&
+'! COPYRIGHT',&
+'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
+'!   Copyright by The HDF Group.                                               *',&
+'!   All rights reserved.                                                      *',&
+'!                                                                             *',&
+'!   This file is part of HDF5.  The full HDF5 copyright notice, including     *',&
+'!   terms governing use, modification, and redistribution, is contained in    *',&
+'!   the files COPYING and Copyright.html.  COPYING can be found at the root   *',&
+'!   of the source code distribution tree; Copyright.html can be found at the  *',&
+'!   root level of an installed copy of the electronic HDF5 document set and   *',&
+'!   is linked from the top-level documents page.  It can also be found at     *',&
+'!   http://hdfgroup.org/HDF5/doc/Copyright.html.  If you do not have          *',&
+'!   access to either file, you may request a copy from help@hdfgroup.org.     *',&
+'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
+'!',&
+'! AUTHOR',&
+'!  H5_test_buildiface.F90',&
+'!',&
+'!*****'
+
+  WRITE(11,'(a)') "MODULE TH5_MISC_gen"
+
+  WRITE(11,'(A)') '  USE, INTRINSIC :: ISO_C_BINDING'
+  
+! Interfaces for validating REALs, INTEGERs, CHARACTERs, LOGICALs
+
+  WRITE(11,'(A)') '  INTERFACE verify'
+  DO i = 1, num_rkinds
+     j = rkind(i)
+     WRITE(chr2,'(I2)') j
+     WRITE(11,'(A)') "     MODULE PROCEDURE verify_real_kind_"//TRIM(ADJUSTL(chr2))
+  END DO
+  DO i = 1, num_ikinds
+     j = ikind(i)
+     WRITE(chr2,'(I2)') j
+     WRITE(11,'(A)') "     MODULE PROCEDURE verify_integer_kind_"//TRIM(ADJUSTL(chr2))
+  END DO
+  WRITE(11,'(A)') "     MODULE PROCEDURE verify_character"
+  WRITE(11,'(A)') "     MODULE PROCEDURE verify_logical"
+  WRITE(11,'(A)') "  END INTERFACE"
+
+  WRITE(11,'(A)') '  INTERFACE check_real_eq'
+  DO i = 1, num_rkinds
+     j = rkind(i)
+     WRITE(chr2,'(I2)') j
+     WRITE(11,'(A)') "     MODULE PROCEDURE real_eq_kind_"//TRIM(ADJUSTL(chr2))
+  END DO
+  WRITE(11,'(A)') "  END INTERFACE"
+
+  WRITE(11,'(A)') 'CONTAINS'
+
+! ***************************
+! VALIDATE INTEGERS
+! ***************************
+  DO i = 1, num_ikinds
+     k = ikind(i)
+     WRITE(chr2,'(I2)') k
+! DLL definitions for windows
+     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
+     WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_integer_kind_'//TRIM(ADJUSTL(chr2))
+     WRITE(11,'(A)') '!DEC$endif'
+
+! Subroutine API
+     WRITE(11,'(A)') '  SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error)'
+     WRITE(11,'(A)') '    IMPLICIT NONE'
+     WRITE(11,'(A)') '    CHARACTER(LEN=*) :: string'
+     WRITE(11,'(A)') '    INTEGER(KIND='//TRIM(ADJUSTL(chr2))//') :: value, correct_value'
+     WRITE(11,'(A)') '    INTEGER :: total_error'
+     WRITE(11,'(A)') '    IF (value .NE. correct_value) THEN'
+     WRITE(11,'(A)') '       total_error=total_error+1'
+     WRITE(11,'(A)') '       WRITE(*,*) "ERROR: INCORRECT INTEGER VALIDATION ", string'
+     WRITE(11,'(A)') '    ENDIF'
+     WRITE(11,'(A)') '  END SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2))
+ ENDDO
+
+! ***************************
+! VALIDATE REALS
+! ***************************
+  DO i = 1, num_rkinds
+     k = rkind(i)
+     WRITE(chr2,'(I2)') k
+! DLL definitions for windows
+     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
+     WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_real_kind_'//TRIM(ADJUSTL(chr2))
+     WRITE(11,'(A)') '!DEC$endif'
+    
+! Subroutine API 
+     WRITE(11,'(A)') '  SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error)'
+     WRITE(11,'(A)') '    IMPLICIT NONE'
+     WRITE(11,'(A)') '    CHARACTER(LEN=*) :: string'
+     WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//') :: value, correct_value'
+     WRITE(11,'(A)') '    INTEGER :: total_error'
+     WRITE(11,'(A)') '    IF (.NOT.real_eq_kind_'//TRIM(ADJUSTL(chr2))//'( value, correct_value) ) THEN'
+     WRITE(11,'(A)') '       total_error=total_error+1'
+     WRITE(11,'(A)') '       WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string'
+     WRITE(11,'(A)') '    ENDIF'
+     WRITE(11,'(A)') '  END SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2))
+
+
+! ***********************************
+! TEST IF TWO REAL NUMBERS ARE EQUAL
+! ***********************************
+
+     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
+     WRITE(11,'(A)') '!DEC$attributes dllexport :: real_eq_kind_'//TRIM(ADJUSTL(chr2))
+     WRITE(11,'(A)') '!DEC$endif'
+     WRITE(11,'(A)') '  LOGICAL FUNCTION real_eq_kind_'//TRIM(ADJUSTL(chr2))//'(a,b)'
+     WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'), INTENT (in):: a,b'
+     WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'), PARAMETER :: eps = 1.e-8'
+     WRITE(11,'(A)') '    real_eq_kind_'//TRIM(ADJUSTL(chr2))//' = ABS(a-b) .LT. eps'
+     WRITE(11,'(A)') '  END FUNCTION real_eq_kind_'//TRIM(ADJUSTL(chr2))
+  ENDDO
+
+! ***************************
+! VALIDATE CHARACTER STRINGS
+! ***************************
+
+! DLL definitions for windows
+  WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
+  WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_character'
+  WRITE(11,'(A)') '!DEC$endif'
+
+! Subroutine API 
+  WRITE(11,'(A)') '  SUBROUTINE verify_character(string,value,correct_value,total_error)'
+  WRITE(11,'(A)') '    IMPLICIT NONE'
+  WRITE(11,'(A)') '    CHARACTER*(*) :: string'
+  WRITE(11,'(A)') '    CHARACTER*(*) :: value, correct_value'
+  WRITE(11,'(A)') '    INTEGER :: total_error'
+  WRITE(11,'(A)') '    IF (TRIM(value) .NE. TRIM(correct_value)) THEN'
+  WRITE(11,'(A)') '       total_error = total_error + 1'
+  WRITE(11,'(A)') '       WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string'
+  WRITE(11,'(A)') '    ENDIF'
+  WRITE(11,'(A)') '  END SUBROUTINE verify_character'
+
+! ***************************
+! VALIDATE LOGICAL
+! ***************************
+
+! DLL definitions for windows
+  WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
+  WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_logical'
+  WRITE(11,'(A)') '!DEC$endif'
+! Subroutine API
+  WRITE(11,'(A)') '  SUBROUTINE verify_logical(string,value,correct_value,total_error)'
+  WRITE(11,'(A)') '    CHARACTER(LEN=*) :: string'
+  WRITE(11,'(A)') '    LOGICAL :: value, correct_value'
+  WRITE(11,'(A)') '    INTEGER :: total_error'
+  WRITE(11,'(A)') '    IF (value .NEQV. correct_value) THEN'
+  WRITE(11,'(A)') '       total_error = total_error + 1'
+  WRITE(11,'(A)') '       WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string'
+  WRITE(11,'(A)') '    ENDIF'
+  
+  WRITE(11,'(A)') '  END SUBROUTINE verify_logical'
+
+  WRITE(11,'(A)') "END MODULE TH5_MISC_gen"
+
+  CLOSE(11)
+
+END PROGRAM H5_test_buildiface
+
+
+