summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--MANIFEST2
-rwxr-xr-xconfigure24
-rw-r--r--configure.ac3
-rw-r--r--fortran/src/H5_f.c50
-rw-r--r--fortran/src/H5_ff.F906
-rw-r--r--fortran/src/H5config_f.inc.in3
-rw-r--r--fortran/src/H5f90global.F907
-rw-r--r--fortran/src/H5test_kind.F90177
-rw-r--r--fortran/test/Makefile.am4
-rw-r--r--fortran/test/Makefile.in6
-rw-r--r--fortran/test/tH5A.f9019
-rw-r--r--fortran/test/tH5A_1_8.f90177
-rw-r--r--fortran/test/tH5D.f901
-rw-r--r--fortran/test/tH5E_F03.f9019
-rw-r--r--fortran/test/tH5F_F03.f9013
-rw-r--r--fortran/test/tH5G_1_8.f90207
-rw-r--r--fortran/test/tH5I.f9010
-rw-r--r--fortran/test/tH5L_F03.f9025
-rw-r--r--fortran/test/tH5MISC_1_8.f9053
-rw-r--r--fortran/test/tH5O.f9056
-rw-r--r--fortran/test/tH5P.f9071
-rw-r--r--fortran/test/tH5P_F03.f9065
-rw-r--r--fortran/test/tH5R.f9035
-rw-r--r--fortran/test/tH5S.f906
-rw-r--r--fortran/test/tH5Sselect.f90211
-rw-r--r--fortran/test/tH5T.f9059
-rw-r--r--fortran/test/tH5T_F03.F90 (renamed from fortran/test/tH5T_F03.f90)274
-rw-r--r--fortran/test/tH5VL.f9030
-rw-r--r--fortran/test/tHDF5.f901
-rw-r--r--fortran/test/tf.F90108
-rw-r--r--m4/aclocal_fc.m414
31 files changed, 865 insertions, 871 deletions
diff --git a/MANIFEST b/MANIFEST
index f3e0236..edc88f7 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -344,7 +344,7 @@
./fortran/test/tH5R.f90
./fortran/test/tH5S.f90
./fortran/test/tH5Sselect.f90
-./fortran/test/tH5T_F03.f90
+./fortran/test/tH5T_F03.F90
./fortran/test/tH5T.f90
./fortran/test/tH5VL.f90
./fortran/test/tH5Z.f90
diff --git a/configure b/configure
index ebec6b5..2ac5c25 100755
--- a/configure
+++ b/configure
@@ -7011,6 +7011,30 @@ fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ ## See if the fortran compiler supports the intrinsic module "ISO_FORTRAN_ENV"
+
+ HAVE_ISO_FORTRAN_ENV="no"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if Fortran compiler supports intrinsic module ISO_FORTRAN_ENV" >&5
+$as_echo_n "checking if Fortran compiler supports intrinsic module ISO_FORTRAN_ENV... " >&6; }
+ cat > conftest.$ac_ext <<_ACEOF
+
+ PROGRAM main
+ USE, INTRINSIC :: ISO_FORTRAN_ENV
+ END PROGRAM
+
+_ACEOF
+if ac_fn_fc_try_link "$LINENO"; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ HAVE_ISO_FORTRAN_ENV="yes"
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+
+
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
diff --git a/configure.ac b/configure.ac
index f5eff26..24ef3ac 100644
--- a/configure.ac
+++ b/configure.ac
@@ -432,6 +432,9 @@ if test "X$HDF_FORTRAN" = "Xyes"; then
## See if C_LONG_DOUBLE is available, and if it is different from C_DOUBLE
PAC_PROG_FC_HAVE_C_LONG_DOUBLE
+ ## See if the fortran compiler supports the intrinsic module "ISO_FORTRAN_ENV"
+ PAC_PROG_FC_ISO_FORTRAN_ENV
+
PAC_FC_NATIVE_INTEGER
PAC_FC_AVAIL_KINDS
diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c
index 5eb6ef8..6a6be41 100644
--- a/fortran/src/H5_f.c
+++ b/fortran/src/H5_f.c
@@ -126,7 +126,11 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes
if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
} /*end if */
else if (sizeof(int_1_f) == sizeof(long long)) {
- if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
+ if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
+ } /*end if */
+ else {
+ if ((types[6] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[6], 128) < 0) return ret_value;
} /*end else */
/*
* FIND H5T_NATIVE_INTEGER_2
@@ -143,6 +147,10 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes
else if (sizeof(int_2_f) == sizeof(long long)) {
if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
} /*end else */
+ else {
+ if ((types[7] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[7], 128) < 0) return ret_value;
+ } /*end else */
/*
* FIND H5T_NATIVE_INTEGER_4
*/
@@ -158,6 +166,10 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes
else if (sizeof(int_4_f) == sizeof(long long)) {
if ((types[8] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
} /*end else */
+ else {
+ if ((types[8] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[8], 128) < 0) return ret_value;
+ } /*end else */
/*
* FIND H5T_NATIVE_INTEGER_8
*/
@@ -173,6 +185,11 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes
else if (sizeof(int_8_f) == sizeof(long long)) {
if ((types[9] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
} /*end else */
+ else {
+ if ((types[9] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[9], 128) < 0) return ret_value;
+ } /*end else */
+
/*
* FIND H5T_NATIVE_REAL_C_FLOAT
*/
@@ -221,7 +238,36 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes
if ((types[13] = (hid_t_f)H5Tcopy(H5T_NATIVE_B8)) < 0) return ret_value;
if ((types[14] = (hid_t_f)H5Tcopy(H5T_NATIVE_B16)) < 0) return ret_value;
if ((types[15] = (hid_t_f)H5Tcopy(H5T_NATIVE_B32)) < 0) return ret_value;
- if ((types[16] = (hid_t_f)H5Tcopy(H5T_NATIVE_B64)) < 0) return ret_value;
+ if ((types[16] = (hid_t_f)H5Tcopy(H5T_NATIVE_B64)) < 0) return ret_value;
+
+/* #ifdef -MSB- */
+ /*
+ * FIND H5T_NATIVE_INTEGER_16
+ */
+ if (sizeof(int_16_f) == sizeof(char)) {
+ if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
+ } /*end if */
+ else if (sizeof(int_16_f) == sizeof(short)) {
+ if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
+ } /*end if */
+ else if (sizeof(int_16_f) == sizeof(int)) {
+ if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
+ } /*end if */
+ else if (sizeof(int_16_f) == sizeof(long long)) {
+ if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
+ } /*end else */
+ else {
+ if ((types[17] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[17], 128) < 0) return ret_value;
+ } /*end else */
+
+
+/* #ifdef -MSB- */
+ /*
+ * FIND H5T_NATIVE_FLOAT_128
+ */
+ if ((types[18] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[18], 128) < 0) return ret_value;
if ((floatingtypes[0] = (hid_t_f)H5Tcopy(H5T_IEEE_F32BE)) < 0) return ret_value;
if ((floatingtypes[1] = (hid_t_f)H5Tcopy(H5T_IEEE_F32LE)) < 0) return ret_value;
diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90
index d7d9efe..25c7eab 100644
--- a/fortran/src/H5_ff.F90
+++ b/fortran/src/H5_ff.F90
@@ -377,6 +377,9 @@ CONTAINS
h5_type = H5T_NATIVE_INTEGER_4
ELSE IF(kind.EQ.Fortran_INTEGER_8)THEN
h5_type = H5T_NATIVE_INTEGER_8
+! NEED ifdef -MSB-
+ ELSE IF(kind.EQ.Fortran_INTEGER_16)THEN
+ h5_type = H5T_NATIVE_INTEGER_16
ENDIF
ELSE IF(flag.EQ.H5_REAL_KIND)THEN
IF(kind.EQ.Fortran_REAL_C_FLOAT)THEN
@@ -385,6 +388,9 @@ CONTAINS
h5_type = H5T_NATIVE_REAL_C_DOUBLE
ELSE IF(kind.EQ.Fortran_REAL_C_LONG_DOUBLE)THEN
h5_type = H5T_NATIVE_REAL_C_LONG_DOUBLE
+! NEED ifdef -MSB-
+ ELSE IF(kind.EQ.Fortran_REAL_C_FLOAT128)THEN
+ h5_type = H5T_NATIVE_FLOAT_128
ENDIF
ENDIF
diff --git a/fortran/src/H5config_f.inc.in b/fortran/src/H5config_f.inc.in
index 3786130..0203315 100644
--- a/fortran/src/H5config_f.inc.in
+++ b/fortran/src/H5config_f.inc.in
@@ -15,5 +15,8 @@
! Define if the intrinsic function C_LONG_DOUBLE exists
#undef FORTRAN_HAVE_C_LONG_DOUBLE
+! Define if the intrinsic module ISO_FORTRAN_ENV exists
+#undef HAVE_ISO_FORTRAN_ENV
+
! Define the size of C's long double
#define H5_SIZEOF_LONG_DOUBLE
diff --git a/fortran/src/H5f90global.F90 b/fortran/src/H5f90global.F90
index 5e67220..c88327c 100644
--- a/fortran/src/H5f90global.F90
+++ b/fortran/src/H5f90global.F90
@@ -66,7 +66,7 @@ MODULE H5GLOBAL
INTEGER, DIMENSION(1:REF_REG_BUF_LEN) :: ref
END TYPE hdset_reg_ref_t_f
- INTEGER, PARAMETER :: PREDEF_TYPES_LEN = 17 ! Do not forget to change this
+ INTEGER, PARAMETER :: PREDEF_TYPES_LEN = 19 ! Do not forget to change this
! value when new predefined
! datatypes are added
@@ -108,6 +108,9 @@ MODULE H5GLOBAL
H5T_STD_U16BE, &
H5T_STD_U16LE, &
H5T_STD_U32BE
+
+ INTEGER(HID_T) :: H5T_NATIVE_INTEGER_16 ! NEED IFDEF -MSB-
+ INTEGER(HID_T) :: H5T_NATIVE_FLOAT_128 ! NEED IFDEF -MSB-
! NOTE: Splitting the line since the Fortran 95 standard limits the number of
! continuation lines to 39; the F03/F08 standard limits the number
@@ -151,6 +154,8 @@ MODULE H5GLOBAL
EQUIVALENCE (predef_types(15), H5T_NATIVE_B16)
EQUIVALENCE (predef_types(16), H5T_NATIVE_B32)
EQUIVALENCE (predef_types(17), H5T_NATIVE_B64)
+ EQUIVALENCE (predef_types(18), H5T_NATIVE_INTEGER_16) ! ADDED NEW TYPE -MSB-
+ EQUIVALENCE (predef_types(19), H5T_NATIVE_FLOAT_128) ! ADDED NEW TYPE -MSB-
INTEGER(HID_T), DIMENSION(FLOATING_TYPES_LEN) :: floating_types
EQUIVALENCE (floating_types(1), H5T_IEEE_F32BE )
diff --git a/fortran/src/H5test_kind.F90 b/fortran/src/H5test_kind.F90
index 018e603..e83139a 100644
--- a/fortran/src/H5test_kind.F90
+++ b/fortran/src/H5test_kind.F90
@@ -322,7 +322,7 @@ WRITE(*,'(40(A,/))') &
!
! Only interfaces with arrays of rank 7 and less are provided. Even-though, the F2008
! standard extended the maximum rank to 15, it was decided that they should use the
-! new APIs to handle this use case. Handling rank 7 and less is for backward compatibility
+! new APIs to handle those use cases. Handling rank 7 and less is for backward compatibility
! with the Fortran 90/95 APIs codes which could never handle rank 15 array sizes.
OPEN(11,FILE='H5_KINDff.F90')
@@ -770,6 +770,181 @@ WRITE(*,'(40(A,/))') &
WRITE(11,'(A)') 'END MODULE H5_KIND'
+ CLOSE(11)
+
+! (b) Generate Fortran Check routines for the tests KIND interfaces.
+ OPEN(11,FILE='../test/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 H5test_kind.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',&
+'! H5test_kind.F90',&
+'!',&
+'!*****'
+
+ WRITE(11,'(a)') "MODULE TH5_MISC_gen"
+
+ WRITE(11,'(A)') ' USE, INTRINSIC :: ISO_C_BINDING'
+ WRITE(11,'(A)') ' USE H5GLOBAL'
+
+! Interfaces for validating REALs, INTEGERs, CHARACTERs, LOGICALs
+
+ WRITE(11,'(A)') ' INTERFACE verify'
+ DO i = 1, ir
+ j = rkind_numbers(i)
+ WRITE(chr2,'(I2)') j
+ WRITE(11,'(A)') " MODULE PROCEDURE verify_real_kind_"//TRIM(ADJUSTL(chr2))
+ END DO
+ DO i = 1, ii
+ j = ikind_numbers(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, ir
+ j = rkind_numbers(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, ii
+ k = ikind_numbers(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, ir
+ k = rkind_numbers(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 test_kind
diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am
index 728b4d7..9c5b4f0 100644
--- a/fortran/test/Makefile.am
+++ b/fortran/test/Makefile.am
@@ -41,7 +41,7 @@ TEST_PROG=fortranlib_test fflush1 fflush2 fortranlib_test_1_8 fortranlib_test_F0
check_PROGRAMS=$(TEST_PROG)
-libh5test_fortran_la_SOURCES = tf.F90 t.c
+libh5test_fortran_la_SOURCES = tf_gen.F90 tf.F90 t.c
# Source files are used for both the library and fortranlib_test.
# Automake will complain about this without the following workaround.
@@ -55,7 +55,7 @@ fortranlib_test_1_8_SOURCES = tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 tH5MISC_1_8.f90
fortranlib_test_1_8.f90
fortranlib_test_F03_SOURCES = tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 \
- tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 tHDF5_F03.f90 fortranlib_test_F03.f90
+ tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.F90 tHDF5_F03.f90 fortranlib_test_F03.f90
fflush1_SOURCES=fflush1.f90
diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in
index be0d503..037ec97 100644
--- a/fortran/test/Makefile.in
+++ b/fortran/test/Makefile.in
@@ -102,7 +102,7 @@ CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
LTLIBRARIES = $(noinst_LTLIBRARIES)
libh5test_fortran_la_LIBADD =
-am_libh5test_fortran_la_OBJECTS = tf.lo t.lo
+am_libh5test_fortran_la_OBJECTS = tf_gen.lo tf.lo t.lo
libh5test_fortran_la_OBJECTS = $(am_libh5test_fortran_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
@@ -729,7 +729,7 @@ noinst_LTLIBRARIES = libh5test_fortran.la
# Our main targets, the tests themselves
TEST_PROG = fortranlib_test fflush1 fflush2 fortranlib_test_1_8 fortranlib_test_F03
-libh5test_fortran_la_SOURCES = tf.F90 t.c
+libh5test_fortran_la_SOURCES = tf_gen.F90 tf.F90 t.c
# Source files are used for both the library and fortranlib_test.
# Automake will complain about this without the following workaround.
@@ -742,7 +742,7 @@ fortranlib_test_1_8_SOURCES = tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 tH5MISC_1_8.f90
fortranlib_test_1_8.f90
fortranlib_test_F03_SOURCES = tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 \
- tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 tHDF5_F03.f90 fortranlib_test_F03.f90
+ tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.F90 tHDF5_F03.f90 fortranlib_test_F03.f90
fflush1_SOURCES = fflush1.f90
fflush2_SOURCES = fflush2.f90
diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90
index e3b3b2a..5b814fa 100644
--- a/fortran/test/tH5A.f90
+++ b/fortran/test/tH5A.f90
@@ -29,6 +29,10 @@
!*****
MODULE TH5A
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE attribute_test(cleanup, total_error)
@@ -36,9 +40,6 @@ CONTAINS
! h5acreate_f, h5awrite_f, h5aclose_f,h5aread_f, h5aopen_name_f,
! h5aget_name_f,h5aget_space_f, h5aget_type_f,
!
-
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
@@ -309,7 +310,7 @@ CONTAINS
!
CALL h5aget_storage_size_f(attr_id, attr_storage, error)
CALL check("h5aget_storage_size_f",error,total_error)
-! CALL VERIFY("h5aget_storage_size_f",attr_storage,*SizeOf(attr_storage),total_error)
+! CALL verify("h5aget_storage_size_f",attr_storage,*SizeOf(attr_storage),total_error)
CALL h5aget_storage_size_f(attr2_id, attr_storage, error)
CALL check("h5aget_storage_size_f",error,total_error)
! CALL verify("h5aget_storage_size_f",attr_storage,1,total_error)
@@ -517,21 +518,15 @@ CONTAINS
data_dims(1) = 1
CALL h5aread_f(attr3_id, H5T_NATIVE_DOUBLE, aread_double_data, data_dims, error)
CALL check("h5aread_f",error,total_error)
+ CALL VERIFY("Read back double attrbute is wrong", aread_double_data(1),3.459_Fortran_DOUBLE,total_error)
- IF( .NOT.dreal_eq( REAL(aread_double_data(1),dp), 3.459_dp) )THEN
- WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1)
- total_error = total_error + 1
- ENDIF
!
!read the real attribute data back to memory
!
data_dims(1) = 1
CALL h5aread_f(attr4_id, H5T_NATIVE_REAL, aread_real_data, data_dims, error)
CALL check("h5aread_f",error,total_error)
- IF( .NOT.dreal_eq( REAL(aread_real_data(1),dp), 4.0_dp) )THEN
- WRITE(*,*) "Read back real attrbute is wrong", aread_real_data(1)
- total_error = total_error + 1
- ENDIF
+ CALL VERIFY("Read back real attrbute is wrong", aread_real_data(1),4.0,total_error)
!
!read the Integer attribute data back to memory
!
diff --git a/fortran/test/tH5A_1_8.f90 b/fortran/test/tH5A_1_8.f90
index 8e20100..c70e288 100644
--- a/fortran/test/tH5A_1_8.f90
+++ b/fortran/test/tH5A_1_8.f90
@@ -32,6 +32,10 @@
!*****
MODULE TH5A_1_8
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE attribute_test_1_8(cleanup, total_error)
@@ -41,8 +45,6 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
! H5Pset_shared_mesg_index_f
!
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -199,8 +201,6 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
! Needed for get_info_by_name
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
@@ -350,7 +350,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
! Verify creation order of attribute
- CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error)
+ CALL verify("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error)
CALL verify("H5Aget_info_by_name_f", corder, u, total_error)
@@ -363,7 +363,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
! Verify creation order of attribute
- CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error)
+ CALL verify("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error)
CALL verify("H5Aget_info_by_name_f", corder, u, total_error)
END DO
@@ -389,8 +389,7 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
!** Tests storing attribute with "null" dataspace
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
+
IMPLICIT NONE
@@ -473,22 +472,22 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
CALL H5Sextent_equal_f(attr_sid, null_sid, equal, error)
CALL check("H5Sextent_equal_f",error,total_error)
- CALL Verifylogical("H5Sextent_equal_f",equal,.TRUE.,total_error)
+ CALL verify("H5Sextent_equal_f",equal,.TRUE.,total_error)
CALL h5aget_storage_size_f(attr, storage_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
- CALL VERIFY("h5aget_storage_size_f",INT(storage_size),0,total_error)
+ CALL verify("h5aget_storage_size_f",INT(storage_size),0,total_error)
CALL h5aget_info_f(attr, f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_f", error, total_error)
! Check the attribute's information
- CALL VERIFY("h5aget_info_f.corder",corder,0,total_error)
+ CALL verify("h5aget_info_f.corder",corder,0,total_error)
- CALL VERIFY("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error)
CALL h5aget_storage_size_f(attr, storage_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
- CALL VERIFY("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error)
+ CALL verify("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error)
CALL h5aclose_f(attr,error)
CALL check("h5aclose_f",error,total_error)
@@ -520,9 +519,6 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(SIZE_T), PARAMETER :: NAME_BUF_SIZE = 7
@@ -735,9 +731,6 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
LOGICAL :: new_format
@@ -859,24 +852,24 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
CALL h5aget_info_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, 0_hsize_t, &
f_corder_valid, corder, cset, data_size, error, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("h5aget_info_by_idx_f",error,minusone,total_error)
+ CALL verify("h5aget_info_by_idx_f",error,minusone,total_error)
! 2) call by passing an integer with the INT(,hsize_t) declaration
CALL h5aget_info_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(0,hsize_t), &
f_corder_valid, corder, cset, data_size, error, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("h5aget_info_by_idx_f",error,minusone,total_error)
+ CALL verify("h5aget_info_by_idx_f",error,minusone,total_error)
! 3) call by passing a variable with the attribute hsize_t
CALL h5aget_info_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, hzero, &
f_corder_valid, corder, cset, data_size, error, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("h5aget_info_by_idx_f",error,minusone,total_error)
+ CALL verify("h5aget_info_by_idx_f",error,minusone,total_error)
CALL h5aget_name_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, &
hzero, tmpname, error, size, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("h5aget_name_by_idx_f",error,minusone,total_error)
+ CALL verify("h5aget_name_by_idx_f",error,minusone,total_error)
! Create attributes, up to limit of compact form
@@ -941,9 +934,6 @@ END SUBROUTINE test_attr_info_by_idx
SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER :: error, total_error
@@ -974,7 +964,7 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
! Verify the name for new link, in increasing creation order
@@ -983,12 +973,12 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
CALL h5aget_name_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, &
n, tmpname, error, NAME_BUF_SIZE)
CALL check("h5aget_name_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_name_by_idx_f", INT(NAME_BUF_SIZE), 7, error)
+ CALL verify("h5aget_name_by_idx_f", INT(NAME_BUF_SIZE), 7, error)
IF(attrname.NE.tmpname)THEN
error = -1
ENDIF
- CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error)
+ CALL verify("h5aget_name_by_idx_f",error,0,total_error)
! Don't test "native" order if there is no creation order index, since
! * there's not a good way to easily predict the attribute's order in the name
@@ -999,13 +989,13 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,0,total_error)
! Verify the information for new attribute, in native creation order
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, n, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
! Verify the name for new link, in increasing native order
CALL h5aget_name_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, &
@@ -1015,14 +1005,14 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
WRITE(*,*) "ERROR: attribute name size wrong!"
error = -1
ENDIF
- CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error)
+ CALL verify("h5aget_name_by_idx_f",error,0,total_error)
END IF
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, n, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,0,total_error)
!EP CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, 0_HSIZE_T, &
@@ -1033,41 +1023,41 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, 0_HSIZE_T, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
! 2) call by passing an integer with the INT(,hsize_t) declaration
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, INT(0,HSIZE_T), &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
! 3) call by passing a variable with the attribute hsize_t
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
!EP CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_HSIZE_T, &
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,0,total_error)
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, n, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_DEC_F, n, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,0,total_error)
!EP CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_DEC_F, 0_HSIZE_T, &
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_DEC_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
END SUBROUTINE attr_info_by_idx_check
@@ -1082,9 +1072,6 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fcpl
@@ -1371,7 +1358,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
! Check size of file
!filesize = h5_get_file_size(FILENAME);
- !VERIFY(filesize, empty_filesize, "h5_get_file_size");
+ !verify(filesize, empty_filesize, "h5_get_file_size");
ENDDO
! Close dataspaces
@@ -1392,9 +1379,6 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
LOGICAL, INTENT(IN) :: new_format
@@ -1518,7 +1502,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
! Check for deleting non-existant attribute
!EP CALL H5Adelete_by_idx_f(my_dataset, '.', idx_type, order, 0_HSIZE_T,error, lapl_id=H5P_DEFAULT_F)
CALL H5Adelete_by_idx_f(my_dataset, '.', idx_type, order, hzero,error, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
+ CALL verify("H5Adelete_by_idx_f",error,minusone,total_error)
! Create attributes, up to limit of compact form
DO u = 0, max_compact - 1
@@ -1546,7 +1530,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
! Check for out of bound deletions
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(u,HSIZE_T), error, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
+ CALL verify("H5Adelete_by_idx_f",error,minusone,total_error)
ENDDO
@@ -1584,10 +1568,10 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
IF(new_format)THEN
IF(order.EQ.H5_ITER_INC_F)THEN
- CALL VERIFY("H5Aget_info_by_idx_f",corder,u + 1,total_error)
+ CALL verify("H5Aget_info_by_idx_f",corder,u + 1,total_error)
ENDIF
ELSE
- CALL VERIFY("H5Aget_info_by_idx_f",corder, max_compact-(u + 2),total_error)
+ CALL verify("H5Aget_info_by_idx_f",corder, max_compact-(u + 2),total_error)
ENDIF
! Verify the name for first attribute in appropriate order
@@ -1604,7 +1588,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
attrname = 'attr '//chr2
ENDIF
IF(TRIM(attrname).NE.TRIM(tmpname)) error = -1
- CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error)
+ CALL verify("h5aget_name_by_idx_f",error,0,total_error)
ENDDO
! Delete last attribute
@@ -1655,7 +1639,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
ENDDO
! Check for out of bound deletion
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(u,HSIZE_T), error)
- CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
+ CALL verify("H5Adelete_by_idx_f",error,minusone,total_error)
ENDDO
! Work on all the datasets
@@ -1684,10 +1668,10 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
f_corder_valid, corder, cset, data_size, error)
IF(new_format)THEN
IF(order.EQ.H5_ITER_INC_F)THEN
- CALL VERIFY("H5Aget_info_by_idx_f",corder,u + 1,total_error)
+ CALL verify("H5Aget_info_by_idx_f",corder,u + 1,total_error)
ENDIF
ELSE
- CALL VERIFY("H5Aget_info_by_idx_f",corder, ((max_compact * 2) - (u + 2)), total_error)
+ CALL verify("H5Aget_info_by_idx_f",corder, ((max_compact * 2) - (u + 2)), total_error)
ENDIF
! Verify the name for first attribute in appropriate order
@@ -1705,7 +1689,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
attrname = 'attr '//chr2
ENDIF
IF(TRIM(attrname).NE.TRIM(tmpname)) error = -1
- CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error)
+ CALL verify("h5aget_name_by_idx_f",error,0,total_error)
ENDDO
@@ -1716,7 +1700,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
! Check for deletion on empty attribute storage again
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error)
- CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
+ CALL verify("H5Adelete_by_idx_f",error,minusone,total_error)
ENDDO
! Close Datasets
@@ -1753,9 +1737,6 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fcpl
@@ -2030,9 +2011,6 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fcpl
@@ -2169,7 +2147,7 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error)
! Check size of file
! filesize = h5_get_file_size(FILENAME);
- ! VERIFY(filesize, empty_filesize, "h5_get_file_size")
+ ! verify(filesize, empty_filesize, "h5_get_file_size")
END SUBROUTINE test_attr_dense_open
@@ -2182,9 +2160,6 @@ END SUBROUTINE test_attr_dense_open
SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: loc_id
@@ -2227,7 +2202,7 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value, data_dims, error)
CALL CHECK("H5Aread_F", error, total_error)
- CALL VERIFY("H5Aread_F", value, u, total_error)
+ CALL verify("H5Aread_F", value, u, total_error)
! Close attribute
CALL h5aclose_f(attr, error)
@@ -2259,7 +2234,7 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
data_dims(1) = 1
CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value, data_dims, error)
CALL CHECK("H5Aread_f", error, total_error)
- CALL VERIFY("H5Aread_f", value, u, total_error)
+ CALL verify("H5Aread_f", value, u, total_error)
! Close attribute
@@ -2278,9 +2253,6 @@ END SUBROUTINE test_attr_dense_verify
SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fcpl
@@ -2314,14 +2286,14 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
! Get creation order indexing on object
CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error)
CALL check("H5Pget_attr_creation_order_f",error,total_error)
- CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error)
+ CALL verify("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error)
! Setting invalid combination of a attribute order creation order indexing on should fail
CALL H5Pset_attr_creation_order_f(dcpl, H5P_CRT_ORDER_INDEXED_F, error)
- CALL VERIFY("H5Pset_attr_creation_order_f",error , minusone, total_error)
+ CALL verify("H5Pset_attr_creation_order_f",error , minusone, total_error)
CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error)
CALL check("H5Pget_attr_creation_order_f",error,total_error)
- CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error)
+ CALL verify("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error)
! Set attribute creation order tracking & indexing for object
CALL h5pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), error)
@@ -2329,7 +2301,7 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error)
CALL check("H5Pget_attr_creation_order_f",error,total_error)
- CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , &
+ CALL verify("H5Pget_attr_creation_order_f",crt_order_flags , &
IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), total_error)
! Create dataspace for dataset
@@ -2374,7 +2346,7 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
! Query the attribute creation properties
CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error)
CALL check("H5Pget_attr_creation_order_f",error,total_error)
- CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , &
+ CALL verify("H5Pget_attr_creation_order_f",crt_order_flags , &
IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), total_error )
! Close property list
@@ -2401,9 +2373,6 @@ END SUBROUTINE test_attr_corder_create_basic
SUBROUTINE test_attr_basic_write(fapl, total_error)
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -2512,7 +2481,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
CALL h5aget_storage_size_f(attr, attr_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
-!EP CALL VERIFY("h5aget_storage_size_f", INT(attr_size), 2*HSIZE_T, total_error)
+!EP CALL verify("h5aget_storage_size_f", INT(attr_size), 2*HSIZE_T, total_error)
! Read attribute information immediately, without closing attribute
@@ -2521,7 +2490,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
! Verify values read in
DO i = 1, ATTR1_DIM1
- CALL VERIFY('h5aread_f',attr_data1(i),read_data1(i), total_error)
+ CALL verify('h5aread_f',attr_data1(i),read_data1(i), total_error)
ENDDO
! CLOSE attribute
@@ -2570,7 +2539,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
size = 18
CALL H5Aget_name_f(attr, size, chr_exact_size, error)
CALL check('H5Aget_name_f',error,total_error)
- CALL VerifyString('H5Aget_name_f',chr_exact_size,ATTR_TMP_NAME, total_error)
+ CALL verify('H5Aget_name_f',chr_exact_size,ATTR_TMP_NAME, total_error)
! Close attribute
CALL h5aclose_f(attr, error)
@@ -2599,9 +2568,6 @@ END SUBROUTINE test_attr_basic_write
SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
LOGICAL, INTENT(IN) :: new_format
@@ -2656,19 +2622,19 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
WRITE(chr5,'(I5.5)') u
attrname = 'attr '//chr5
CALL H5Aexists_f( gid, attrname, exists, error)
- CALL VerifyLogical("H5Aexists",exists,.FALSE.,total_error )
+ CALL verify("H5Aexists",exists,.FALSE.,total_error )
CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error, lapl_id = H5P_DEFAULT_F)
- CALL VerifyLogical("H5Aexists_by_name_f",exists,.FALSE.,total_error )
+ CALL verify("H5Aexists_by_name_f",exists,.FALSE.,total_error )
CALL h5acreate_f(gid, attrname, H5T_NATIVE_INTEGER, sid, aid, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
CALL H5Aexists_f(gid, attrname, exists, error)
- CALL VerifyLogical("H5Aexists",exists,.TRUE.,total_error )
+ CALL verify("H5Aexists",exists,.TRUE.,total_error )
CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error)
- CALL VerifyLogical("H5Aexists_by_name_f",exists,.TRUE.,total_error )
+ CALL verify("H5Aexists_by_name_f",exists,.TRUE.,total_error )
attr_data1(1) = u
data_dims(1) = 1
@@ -2680,10 +2646,10 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
CALL check("h5aclose_f",error,total_error)
CALL H5Aexists_f(gid, attrname, exists, error)
- CALL VerifyLogical("H5Aexists",exists,.TRUE.,total_error )
+ CALL verify("H5Aexists",exists,.TRUE.,total_error )
CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error)
- CALL VerifyLogical("H5Aexists_by_name_f",exists,.TRUE.,total_error )
+ CALL verify("H5Aexists_by_name_f",exists,.TRUE.,total_error )
ENDDO
@@ -2717,9 +2683,6 @@ END SUBROUTINE test_attr_many
SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fid
CHARACTER(LEN=*), INTENT(IN) :: dsetname
@@ -2757,13 +2720,13 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
CALL check("h5aget_info_f",error,total_error)
! Check that the object's attributes are correct
- CALL VERIFY("h5aget_info_f.corder",corder,u,total_error)
- CALL Verifylogical("h5aget_info_f.corder_valid",f_corder_valid,.TRUE.,total_error)
- CALL VERIFY("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("h5aget_info_f.corder",corder,u,total_error)
+ CALL verify("h5aget_info_f.corder_valid",f_corder_valid,.TRUE.,total_error)
+ CALL verify("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error)
CALL h5aget_storage_size_f(attr_id, storage_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
- CALL VERIFY("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error)
+ CALL verify("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error)
! Close attribute
@@ -2778,12 +2741,12 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_f",error,total_error)
! Check the attribute's information
- CALL VERIFY("h5aget_info_f",corder,u,total_error)
- CALL Verifylogical("h5aget_info_f",f_corder_valid,.TRUE.,total_error)
- CALL VERIFY("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("h5aget_info_f",corder,u,total_error)
+ CALL verify("h5aget_info_f",f_corder_valid,.TRUE.,total_error)
+ CALL verify("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error)
CALL h5aget_storage_size_f(attr_id, storage_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
- CALL VERIFY("h5aget_info_f", INT(data_size), INT(storage_size), total_error)
+ CALL verify("h5aget_info_f", INT(data_size), INT(storage_size), total_error)
! Close attribute
CALL h5aclose_f(attr_id, error)
@@ -2800,12 +2763,12 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
CALL check("h5aget_info_f",error,total_error)
! Check the attribute's information
- CALL VERIFY("h5aget_info_f",corder,u,total_error)
- CALL Verifylogical("h5aget_info_f",f_corder_valid,.TRUE.,total_error)
- CALL VERIFY("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("h5aget_info_f",corder,u,total_error)
+ CALL verify("h5aget_info_f",f_corder_valid,.TRUE.,total_error)
+ CALL verify("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error)
CALL h5aget_storage_size_f(attr_id, storage_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
- CALL VERIFY("h5aget_info_f", INT(data_size), INT(storage_size), total_error)
+ CALL verify("h5aget_info_f", INT(data_size), INT(storage_size), total_error)
! Close attribute
CALL h5aclose_f(attr_id, error)
diff --git a/fortran/test/tH5D.f90 b/fortran/test/tH5D.f90
index c0eb8f9..6d136b5 100644
--- a/fortran/test/tH5D.f90
+++ b/fortran/test/tH5D.f90
@@ -40,6 +40,7 @@ CONTAINS
SUBROUTINE datasettest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
+ USE TH5_MISC_GEN
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
diff --git a/fortran/test/tH5E_F03.f90 b/fortran/test/tH5E_F03.f90
index a7d45f2..63e70a3 100644
--- a/fortran/test/tH5E_F03.f90
+++ b/fortran/test/tH5E_F03.f90
@@ -36,6 +36,9 @@
! *****************************************
MODULE test_my_hdf5_error_handler
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
CONTAINS
@@ -49,8 +52,6 @@ CONTAINS
! This error function handle works with only version 2 error stack
- USE HDF5
- USE ISO_C_BINDING
IMPLICIT NONE
! estack_id is always passed from C as: H5E_DEFAULT
@@ -74,8 +75,6 @@ CONTAINS
! This error function handle works with only version 2 error stack
- USE HDF5
- USE ISO_C_BINDING
IMPLICIT NONE
! estack_id is always passed from C as: H5E_DEFAULT
@@ -102,8 +101,6 @@ CONTAINS
SUBROUTINE test_error(total_error)
- USE HDF5
- USE TH5_MISC
USE ISO_C_BINDING
USE test_my_hdf5_error_handler
@@ -147,15 +144,15 @@ SUBROUTINE test_error(total_error)
! Create the erring dataset
CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error)
- CALL VERIFY("h5dcreate_f", error, -1, total_error)
+ CALL verify("h5dcreate_f", error, -1, total_error)
-!!$ CALL VERIFY("H5Eset_auto_f",my_hdf5_error_handler_data(1),10, total_error)
-!!$ CALL VERIFY("H5Eset_auto_f",my_hdf5_error_handler_data(2),20, total_error)
+!!$ CALL verify("H5Eset_auto_f",my_hdf5_error_handler_data(1),10, total_error)
+!!$ CALL verify("H5Eset_auto_f",my_hdf5_error_handler_data(2),20, total_error)
!!$ ! Test enabling and disabling default printing
!!$
!!$ CALL H5Eget_auto_f(H5E_DEFAULT_F, func1, f_ptr1, error)
-!!$ CALL VERIFY("H5Eget_auto_f", error, 0, total_error)
+!!$ CALL verify("H5Eget_auto_f", error, 0, total_error)
! PRINT*,c_associated(f_ptr1)
@@ -187,7 +184,7 @@ SUBROUTINE test_error(total_error)
CALL H5Eset_auto_f(1, error, H5E_DEFAULT_F, func, f_ptr)
CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error)
- CALL VERIFY("h5dcreate_f", error, -1, total_error)
+ CALL verify("h5dcreate_f", error, -1, total_error)
! turn on automatic printing with h5eprint_f which prints an error stack in the default manner.
diff --git a/fortran/test/tH5F_F03.f90 b/fortran/test/tH5F_F03.f90
index c878a59..9e23d19 100644
--- a/fortran/test/tH5F_F03.f90
+++ b/fortran/test/tH5F_F03.f90
@@ -38,16 +38,17 @@
MODULE TH5F_F03
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+ USE ISO_C_BINDING
+
CONTAINS
SUBROUTINE test_get_file_image(total_error)
!
! Tests the wrapper for h5fget_file_image
!
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error ! returns error
@@ -128,8 +129,8 @@ SUBROUTINE test_get_file_image(total_error)
itmp_a = 1
CALL h5fget_file_image_f(file_id, f_ptr, itmp_a, error, image_size)
CALL check("h5fget_file_image_f",error, total_error)
- CALL VERIFY("h5fget_file_image_f", INT(itmp_a), 1, total_error) ! Routine should not change the value
- CALL VERIFY("h5fget_file_image_f", file_sz, INT(image_size), total_error)
+ CALL verify("h5fget_file_image_f", INT(itmp_a), 1, total_error) ! Routine should not change the value
+ CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error)
! Allocate a buffer of the appropriate size
ALLOCATE(image_ptr(1:image_size))
diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90
index ab75163..ddc3736 100644
--- a/fortran/test/tH5G_1_8.f90
+++ b/fortran/test/tH5G_1_8.f90
@@ -31,11 +31,13 @@
MODULE TH5G_1_8
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE group_test(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -139,9 +141,6 @@ END SUBROUTINE group_test
SUBROUTINE group_info(cleanup, fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -269,7 +268,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! Check for out of bound query by index on empty group, should fail
CALL H5Gget_info_by_idx_f(group_id, ".", H5_INDEX_NAME_F, order, INT(0,HSIZE_T), &
storage_type, nlinks, max_corder, error)
- CALL VERIFY("H5Gget_info_by_idx_f", error, -1, total_error)
+ CALL verify("H5Gget_info_by_idx_f", error, -1, total_error)
! Create several links, up to limit of compact form
DO u = 0, max_compact-1
@@ -287,29 +286,29 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Gget_info_f", error, total_error)
! Check (new/empty) group's information
- CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_f", max_corder, 0, total_error)
- CALL VERIFY("H5Gget_info_f", nlinks, 0, total_error)
- CALL verifyLogical("H5Gget_info_f.mounted", mounted,.FALSE.,total_error)
+ CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_f", max_corder, 0, total_error)
+ CALL verify("H5Gget_info_f", nlinks, 0, total_error)
+ CALL verify("H5Gget_info_f.mounted", mounted,.FALSE.,total_error)
! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error, mounted=mounted)
CALL check("H5Gget_info_by_name_f", error, total_error)
! Check (new/empty) group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", max_corder, 0, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, 0, total_error)
- CALL verifyLogical("H5Gget_info_by_name_f.mounted", mounted,.FALSE.,total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f", max_corder, 0, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, 0, total_error)
+ CALL verify("H5Gget_info_by_name_f.mounted", mounted,.FALSE.,total_error)
! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name", error, total_error)
! Check (new/empty) group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", max_corder, 0, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, 0, total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f", max_corder, 0, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, 0, total_error)
! Create objects in new group created
DO v = 0, u
@@ -331,27 +330,27 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Gget_info_f", error, total_error)
! Check (new) group's information
- CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_f", nlinks, u+1, total_error)
! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name_f", error, total_error)
! Check (new) group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f",max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f",max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error)
! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name_f", error, total_error)
! Check (new) group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error)
! Retrieve group's information
IF(order.NE.H5_ITER_NATIVE_F)THEN
@@ -359,17 +358,17 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(u,HSIZE_T), &
storage_type, nlinks, max_corder, error,lapl_id=H5P_DEFAULT_F, mounted=mounted)
CALL check("H5Gget_info_by_idx_f", error, total_error)
- CALL verifyLogical("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error)
+ CALL verify("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error)
ELSE
CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(0,HSIZE_T), &
storage_type, nlinks, max_corder, error, mounted=mounted)
- CALL verifyLogical("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error)
+ CALL verify("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error)
CALL check("H5Gget_info_by_idx_f", error, total_error)
ENDIF
! Check (new) group's information
- CALL VERIFY("H5Gget_info_by_idx_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_idx_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_by_idx_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_by_idx_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_idx_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_by_idx_f", nlinks, u+1, total_error)
ENDIF
! Close group created
CALL H5Gclose_f(group_id2, error)
@@ -380,27 +379,27 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Gget_info_f", error, total_error)
! Check main group's information
- CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_f", nlinks, u+1, total_error)
! Retrieve main group's information, by name
CALL H5Gget_info_by_name_f(file_id, CORDER_GROUP_NAME, storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name_f", error, total_error)
! Check main group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error)
! Retrieve main group's information, by name
CALL H5Gget_info_by_name_f(group_id, ".", storage_type, nlinks, max_corder, error, H5P_DEFAULT_F)
CALL check("H5Gget_info_by_name_f", error, total_error)
! Check main group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error)
! Create soft link in another group, to objects in main group
valname = CORDER_GROUP_NAME//objname
@@ -412,9 +411,9 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Gget_info_f", error, total_error)
! Check soft link group's information
- CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_f", nlinks, u+1, total_error)
ENDDO
! Close the groups
@@ -456,9 +455,6 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
SUBROUTINE timestamps(cleanup, fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -491,7 +487,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
! Check default timestamp information
- CALL VerifyLogical("H5Pget_obj_track_times",track_times,.TRUE.,total_error)
+ CALL verify("H5Pget_obj_track_times",track_times,.TRUE.,total_error)
! Set a non-default object timestamp setting
CALL H5Pset_obj_track_times_f(gcpl_id, .FALSE., error)
@@ -502,7 +498,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
! Check default timestamp information
- CALL VerifyLogical("H5Pget_obj_track_times",track_times,.FALSE.,total_error)
+ CALL verify("H5Pget_obj_track_times",track_times,.FALSE.,total_error)
! Create file
!h5_fixname(FILENAME[0], fapl, filename, sizeof filename);
@@ -533,10 +529,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! Query & verify the object timestamp settings
CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
- CALL VerifyLogical("H5Pget_obj_track_times1",track_times,.FALSE.,total_error)
+ CALL verify("H5Pget_obj_track_times1",track_times,.FALSE.,total_error)
CALL H5Pget_obj_track_times_f(gcpl_id2, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
- CALL VerifyLogical("H5Pget_obj_track_times2",track_times,.TRUE.,total_error)
+ CALL verify("H5Pget_obj_track_times2",track_times,.TRUE.,total_error)
! Query the object information for each group
! if(H5Oget_info(group_id, &oinfo) < 0) TEST_ERROR
@@ -593,10 +589,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
- CALL VerifyLogical("H5Pget_obj_track_times1",track_times,.FALSE.,total_error)
+ CALL verify("H5Pget_obj_track_times1",track_times,.FALSE.,total_error)
CALL H5Pget_obj_track_times_f(gcpl_id2, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
- CALL VerifyLogical("H5Pget_obj_track_times2",track_times,.TRUE.,total_error)
+ CALL verify("H5Pget_obj_track_times2",track_times,.TRUE.,total_error)
!!$
!!$ Query the object information for each group
!!$ if(H5Oget_info(group_id, &oinfo) < 0) TEST_ERROR
@@ -653,9 +649,6 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
SUBROUTINE mklinks(fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -711,12 +704,12 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
error, H5P_DEFAULT_F)
CALL check("H5Lget_info_f",error,total_error)
-! CALL VerifyLogical("H5Lget_info_by_idx_f11", f_corder_valid, .TRUE., total_error)
+! CALL verify("H5Lget_info_by_idx_f11", f_corder_valid, .TRUE., total_error)
- CALL VERIFY("H5Lget_info_by_idx_f", H5L_TYPE_SOFT_F, link_type, total_error)
- CALL VERIFY("H5Lget_info_by_idx_f", cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("H5Lget_info_by_idx_f", H5L_TYPE_SOFT_F, link_type, total_error)
+ CALL verify("H5Lget_info_by_idx_f", cset, H5T_CSET_ASCII_F, total_error)
! should be '/d1' + NULL character = 4
- CALL VERIFY("H5Lget_info_by_idx_f", INT(val_size), 4, total_error)
+ CALL verify("H5Lget_info_by_idx_f", INT(val_size), 4, total_error)
! Create a symbolic link to something that doesn't exist
@@ -749,9 +742,6 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
SUBROUTINE test_move_preserves(fapl_id, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl_id
@@ -798,14 +788,14 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL H5Pget_link_creation_order_f(fcpl_id, crt_order_flags, error)
CALL check("H5Pget_link_creation_order_f",error, total_error)
- CALL VERIFY("H5Pget_link_creation_order_f",crt_order_flags,0, total_error)
+ CALL verify("H5Pget_link_creation_order_f",crt_order_flags,0, total_error)
CALL H5Pset_link_creation_order_f(fcpl_id, H5P_CRT_ORDER_TRACKED_F, error)
CALL check("H5Pset_link_creation_order_f", error, total_error)
CALL H5Pget_link_creation_order_f(fcpl_id, crt_order_flags, error)
CALL check("H5Pget_link_creation_order_f",error, total_error)
- CALL VERIFY("H5Pget_link_creation_order_f",crt_order_flags, H5P_CRT_ORDER_TRACKED_F, total_error)
+ CALL verify("H5Pget_link_creation_order_f",crt_order_flags, H5P_CRT_ORDER_TRACKED_F, total_error)
! Create file
! (with creation order tracking for the root group)
@@ -835,10 +825,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! if(H5Oget_info_by_name(file_id, "group", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR
old_cset = cset
- CALL VERIFY("H5Lget_info_f",old_cset,H5T_CSET_UTF8_F,total_error)
- CALL VerifyLogical("H5Lget_info_f",f_corder_valid,.TRUE.,total_error)
+ CALL verify("H5Lget_info_f",old_cset,H5T_CSET_UTF8_F,total_error)
+ CALL verify("H5Lget_info_f",f_corder_valid,.TRUE.,total_error)
old_corder = corder;
- CALL VERIFY("H5Lget_info_f",old_corder,0,total_error)
+ CALL verify("H5Lget_info_f",old_corder,0,total_error)
! old_modification_time = oinfo.mtime;
@@ -956,10 +946,6 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
!
SUBROUTINE lifecycle(cleanup, fapl2, total_error)
-
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl2
@@ -1105,10 +1091,6 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
SUBROUTINE cklinks(fapl, total_error)
-! USE ISO_C_BINDING
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -1146,10 +1128,10 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
CALL H5Lexists_f(file,"d1",Lexists, error)
- CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error)
+ CALL verify("H5Lexists", Lexists,.TRUE.,total_error)
CALL H5Lexists_f(file,"grp1/hard",Lexists, error)
- CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error)
+ CALL verify("H5Lexists", Lexists,.TRUE.,total_error)
! Cleanup
CALL H5Fclose_f(file,error)
@@ -1176,9 +1158,6 @@ END SUBROUTINE cklinks
!
SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -1294,7 +1273,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
! Check for deletion on empty group
CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), error)
- CALL VERIFY("delete_by_idx.H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1)
+ CALL verify("delete_by_idx.H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1)
! Create several links, up to limit of compact form
DO u = 0, max_compact-1
! Make name for link
@@ -1319,7 +1298,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
htmp =9
!EP CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(u,HSIZE_T), error)
CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, htmp, error)
- CALL VERIFY("H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1)
+ CALL verify("H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1)
! Delete links from compact group
@@ -1340,21 +1319,21 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
CALL H5Iget_type_f(grp, id_type, error)
CALL check("H5Iget_type_f", error, total_error)
- CALL VERIFY("H5Iget_type_f", id_type, H5I_GROUP_F, total_error)
+ CALL verify("H5Iget_type_f", id_type, H5I_GROUP_F, total_error)
CALL H5Gclose_f(grp, error)
CALL check("H5Gclose_f", error, total_error)
- CALL VerifyLogical("H5Lget_info_by_idx_f", f_corder_valid, .TRUE., total_error)
+ CALL verify("H5Lget_info_by_idx_f", f_corder_valid, .TRUE., total_error)
- CALL VERIFY("H5Lget_info_by_idx_f", H5L_TYPE_HARD_F, link_type, total_error)
+ CALL verify("H5Lget_info_by_idx_f", H5L_TYPE_HARD_F, link_type, total_error)
IF(iorder.EQ.H5_ITER_INC_F)THEN
- CALL VERIFY("H5Lget_info_by_idx_f", corder, u+1, total_error)
+ CALL verify("H5Lget_info_by_idx_f", corder, u+1, total_error)
ELSE
- CALL VERIFY("H5Lget_info_by_idx_f", corder, (max_compact - (u + 2)), total_error)
+ CALL verify("H5Lget_info_by_idx_f", corder, (max_compact - (u + 2)), total_error)
ENDIF
- CALL VERIFY("H5Lget_info_by_idx_f",cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("H5Lget_info_by_idx_f",cset, H5T_CSET_ASCII_F, total_error)
@@ -1371,7 +1350,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
!!$ ENDIF
!!$ objname = 'fill '//chr2
!!$ PRINT*,objname, tmpname
-!!$ CALL verifyString("delete_by_idx.H5Lget_name_by_idx_f", objname, tmpname, total_error)
+!!$ CALL verify("delete_by_idx.H5Lget_name_by_idx_f", objname, tmpname, total_error)
ENDDO
! Close the group
@@ -1418,9 +1397,6 @@ END SUBROUTINE delete_by_idx
SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
hard_link, use_index, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: group_id
@@ -1455,14 +1431,14 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(0,HSIZE_T), &
link_type, f_corder_valid, corder, cset, address, val_size, error)
CALL check("H5Lget_info_by_idx_f", error, total_error)
- CALL VERIFY("H5Lget_info_by_idx_f", corder, 0, total_error)
+ CALL verify("H5Lget_info_by_idx_f", corder, 0, total_error)
! Verify the link information for new link, in increasing creation order
! HDmemset(&linfo, 0, sizeof(linfo));
CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), &
link_type, f_corder_valid, corder, cset, address, val_size, error)
CALL check("H5Lget_info_by_idx_f", error, total_error)
- CALL VERIFY("H5Lget_info_by_idx_f", corder, n, total_error)
+ CALL verify("H5Lget_info_by_idx_f", corder, n, total_error)
! Verify value for new soft link, in increasing creation order
!!$ IF(hard_link)THEN
@@ -1481,21 +1457,21 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL H5Lget_name_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), tmpname_small, error, size_tmp)
CALL check("link_info_by_idx_check.H5Lget_name_by_idx_f", error, total_error)
- CALL verifyString("link_info_by_idx_check.H5Lget_name_by_idx_f", &
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", &
linkname(1:LEN(tmpname_small)), tmpname_small(1:LEN(tmpname_small)), total_error)
- CALL VERIFY("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
! try it with the correct size
CALL H5Lget_name_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), tmpname, error, size=size_tmp)
CALL check("link_info_by_idx_check.H5Lget_name_by_idx_f", error, total_error)
- CALL verifyString("link_info_by_idx_check.H5Lget_name_by_idx_f", &
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", &
linkname(1:LEN(tmpname)), tmpname(1:LEN(tmpname)), total_error)
- CALL VERIFY("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
CALL H5Lget_name_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), tmpname_big, error, size_tmp)
CALL check("link_info_by_idx_check.H5Lget_name_by_idx_f", error, total_error)
- CALL verifyString("link_info_by_idx_check.H5Lget_name_by_idx_f", &
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", &
linkname(1:7), tmpname_big(1:7), total_error)
- CALL VERIFY("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
! Try with a buffer set to small
@@ -1522,9 +1498,6 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
SUBROUTINE test_lcpl(cleanup, fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -1591,7 +1564,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
! * creation property list and is always ASCII.
!#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h --
- CALL VERIFY("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error)
+ CALL verify("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error)
! Create and commit a datatype with the default LCPL
CALL h5tcopy_f(H5T_NATIVE_INTEGER, type_id, error)
@@ -1652,10 +1625,10 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
DO i = 1, 2
tmp1 = INT(dimsout(i))
tmp2 = INT(extend_dim(i))
- CALL VERIFY("H5Sget_simple_extent_dims", tmp1, tmp2, total_error)
+ CALL verify("H5Sget_simple_extent_dims", tmp1, tmp2, total_error)
tmp1 = INT(maxdimsout(i))
tmp2 = INT(dims(i))
- CALL VERIFY("H5Sget_simple_extent_dims", tmp1, tmp2, total_error)
+ CALL verify("H5Sget_simple_extent_dims", tmp1, tmp2, total_error)
ENDDO
! close data set
@@ -1722,7 +1695,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL H5Pget_char_encoding_f(lcpl_id, encoding, error)
CALL check("H5Pget_char_encoding_f", error, total_error)
- CALL VERIFY("H5Pget_char_encoding_f", encoding, H5T_CSET_UTF8_F, total_error)
+ CALL verify("H5Pget_char_encoding_f", encoding, H5T_CSET_UTF8_F, total_error)
! Check that its character encoding is UTF-8
CALL H5Lget_info_f(file_id, "dataset2", &
@@ -1744,7 +1717,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL H5Lexists_f(file_id,"/dataset2_link",Lexists, error)
CALL check("H5Lexists",error, total_error)
- CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error)
+ CALL verify("H5Lexists", Lexists,.TRUE.,total_error)
! Check that its character encoding is ASCII
CALL H5Lget_info_f(file_id, "/dataset2_link", &
@@ -1834,9 +1807,6 @@ END SUBROUTINE test_lcpl
SUBROUTINE objcopy(fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -1867,7 +1837,7 @@ SUBROUTINE objcopy(fapl, total_error)
! Verify object copy flags
CALL H5Pget_copy_object_f(pid, cpy_flags, error)
CALL check("H5Pget_copy_object_f",error, total_error)
- CALL VERIFY("H5Pget_copy_object_f", cpy_flags, flag, total_error)
+ CALL verify("H5Pget_copy_object_f", cpy_flags, flag, total_error)
!!$
!!$ CALL test_copy_option(fcpl_src, fcpl_dst, my_fapl, H5O_COPY_WITHOUT_ATTR_FLAG,
@@ -1898,9 +1868,6 @@ END SUBROUTINE objcopy
SUBROUTINE lapl_nlinks( fapl, total_error)
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fapl
INTEGER, INTENT(INOUT) :: total_error
@@ -1972,7 +1939,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
nlinks = 0
CALL H5Pget_nlinks_f(plist, nlinks, error)
CALL check("H5Pset_nlinks_f",error,total_error)
- CALL VERIFY("H5Pset_nlinks_f",INT(nlinks), 20, total_error)
+ CALL verify("H5Pset_nlinks_f",INT(nlinks), 20, total_error)
! Open object through what is normally too many soft links using
@@ -1984,7 +1951,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
! Check name
CALL h5iget_name_f(gid, objname, buf_size, name_len, error)
CALL check("h5iget_name_f",error,total_error)
- CALL VerifyString("h5iget_name_f", TRIM(objname),"/soft17", total_error)
+ CALL verify("h5iget_name_f", TRIM(objname),"/soft17", total_error)
! Create group using soft link
CALL H5Gcreate_f(gid, "new_soft", gid2, error)
CALL check("H5Gcreate_f", error, total_error)
@@ -2006,12 +1973,12 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
CALL H5Pget_nlinks_f(plist, nlinks, error)
CALL check("H5Pget_nlinks_f",error,total_error)
- CALL VERIFY("H5Pget_nlinks_f", INT(nlinks), 4, total_error)
+ CALL verify("H5Pget_nlinks_f", INT(nlinks), 4, total_error)
! Try opening through what is now too many soft links
CALL H5Oopen_f(fid,"soft5",gid,error,plist)
- CALL VERIFY("H5Oopen_f", error, -1, total_error) ! should fail
+ CALL verify("H5Oopen_f", error, -1, total_error) ! should fail
! Open object through lesser soft link
CALL H5Oopen_f(fid,"soft4",gid,error,plist)
@@ -2020,7 +1987,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
! Check name
CALL h5iget_name_f(gid, objname, buf_size, name_len, error)
CALL check("h5iget_name_f",error,total_error)
- CALL VerifyString("h5iget_name_f", TRIM(objname),"/soft4", total_error)
+ CALL verify("h5iget_name_f", TRIM(objname),"/soft4", total_error)
! Test other functions that should use a LAPL
nlinks = 20
diff --git a/fortran/test/tH5I.f90 b/fortran/test/tH5I.f90
index 088b4eb..97c48c6 100644
--- a/fortran/test/tH5I.f90
+++ b/fortran/test/tH5I.f90
@@ -27,6 +27,10 @@
!
!*****
MODULE TH5I
+
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
CONTAINS
@@ -34,8 +38,6 @@ CONTAINS
! This subroutine tests following functionalities: h5iget_type_f
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -88,7 +90,7 @@ CONTAINS
dtype = -1
CALL H5Iis_valid_f(dtype, tri_ret, error)
CALL check("H5Iis_valid_f", error, total_error)
- CALL VerifyLogical("H5Iis_valid_f", tri_ret, .FALSE., total_error)
+ CALL verify("H5Iis_valid_f", tri_ret, .FALSE., total_error)
! Create a datatype id
CALL H5Tcopy_f(H5T_NATIVE_INTEGER,dtype,error)
@@ -97,7 +99,7 @@ CONTAINS
! Check that the ID is valid
CALL H5Iis_valid_f(dtype, tri_ret, error)
CALL check("H5Iis_valid_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", tri_ret, .TRUE., total_error)
+ CALL verify("H5Tequal_f", tri_ret, .TRUE., total_error)
CALL H5Tclose_f(dtype, error)
CALL check("H5Tclose_f", error, total_error)
diff --git a/fortran/test/tH5L_F03.f90 b/fortran/test/tH5L_F03.f90
index 0d3b6b4..40afdbc 100644
--- a/fortran/test/tH5L_F03.f90
+++ b/fortran/test/tH5L_F03.f90
@@ -32,8 +32,10 @@
!*****
MODULE liter_cb_mod
- USE HDF5
- USE ISO_C_BINDING
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+ USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
TYPE iter_enum
@@ -60,8 +62,6 @@ CONTAINS
INTEGER(KIND=C_INT) FUNCTION liter_cb(group, name, link_info, op_data) bind(C)
- USE HDF5
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER(HID_T), VALUE :: group
@@ -123,9 +123,6 @@ CONTAINS
!***************************************************************
SUBROUTINE test_iter_group(total_error)
- USE HDF5
- USE TH5_MISC
- USE, INTRINSIC :: ISO_C_BINDING
USE liter_cb_mod
IMPLICIT NONE
@@ -251,11 +248,11 @@ SUBROUTINE test_iter_group(total_error)
CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, error)
IF(error.LT.0) EXIT
! Verify return value from iterator gets propagated correctly
- CALL VERIFY("H5Literate", ret_value, 2, total_error)
+ CALL verify("H5Literate", ret_value, 2, total_error)
! Increment the number of times "2" is returned
i = i + 1
! Verify that the index is the correct value
- CALL VERIFY("H5Literate", INT(idx), INT(i), total_error)
+ CALL verify("H5Literate", INT(idx), INT(i), total_error)
IF(idx .GT.ndatasets+2)THEN
PRINT*,"ERROR: Group iteration function walked too far!"
ENDIF
@@ -264,14 +261,14 @@ SUBROUTINE test_iter_group(total_error)
DO j = 1, 10
ichr10(j:j) = info%name(j)(1:1)
ENDDO
- CALL verifystring("H5Literate_f", ichr10, lnames(INT(idx)), total_error)
+ CALL verify("H5Literate_f", ichr10, lnames(INT(idx)), total_error)
IF(i.EQ.52)EXIT ! prints out error message otherwise (for gcc/gfortran/g95) not intel (why) -FIXME- scot
END DO
! put check if did not walk far enough -scot FIXME
IF(i .NE. (NDATASETS + 2)) THEN
- CALL VERIFY("H5Literate_f", i, INT(NDATASETS + 2), total_error)
+ CALL verify("H5Literate_f", i, INT(NDATASETS + 2), total_error)
PRINT*,"ERROR: Group iteration function didn't perform multiple iterations correctly"
ENDIF
@@ -288,13 +285,13 @@ SUBROUTINE test_iter_group(total_error)
CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, error)
IF(error.LT.0) EXIT
- CALL VERIFY("H5Literate_f", ret_value, 1, total_error)
+ CALL verify("H5Literate_f", ret_value, 1, total_error)
! Increment the number of times "1" is returned
i = i + 1
! Verify that the index is the correct value
- CALL VERIFY("H5Literate_f", INT(idx), INT(i+10), total_error)
+ CALL verify("H5Literate_f", INT(idx), INT(i+10), total_error)
IF(idx .GT.ndatasets+2)THEN
PRINT*,"Group iteration function walked too far!"
@@ -304,7 +301,7 @@ SUBROUTINE test_iter_group(total_error)
ichr10(j:j) = info%name(j)(1:1)
ENDDO
! Verify that the correct name is retrieved
- CALL verifystring("H5Literate_f", ichr10, lnames(INT(idx)), total_error)
+ CALL verify("H5Literate_f", ichr10, lnames(INT(idx)), total_error)
IF(i.EQ.42)EXIT ! prints out error message otherwise (for gcc/gfortran/g95) not intel (why) -FIX- scot
ENDDO
diff --git a/fortran/test/tH5MISC_1_8.f90 b/fortran/test/tH5MISC_1_8.f90
index efaf594..ba3f095 100644
--- a/fortran/test/tH5MISC_1_8.f90
+++ b/fortran/test/tH5MISC_1_8.f90
@@ -25,11 +25,13 @@
!*****
MODULE TH5MISC_1_8
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE dtransform(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -57,22 +59,22 @@ SUBROUTINE dtransform(cleanup, total_error)
CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest, error, size=size)
CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
- CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f, ptrgetTest, total_error)
- CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", c_to_f, ptrgetTest, total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
! check case when receiving buffer to small
CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_small, error, size=size)
CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
- CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:7), ptrgetTest_small, total_error)
- CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", c_to_f(1:7), ptrgetTest_small, total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
! check case when receiving buffer to big
CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_big, error, size=size)
CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
- CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:15), ptrgetTest_big(1:15), total_error)
- CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size), 15, total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", c_to_f(1:15), ptrgetTest_big(1:15), total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", INT(size), 15, total_error)
CALL H5Fclose_f(file_id, error)
CALL check("H5Fclose_f", error, total_error)
@@ -92,9 +94,6 @@ END SUBROUTINE dtransform
SUBROUTINE test_genprop_basic_class(total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -117,7 +116,7 @@ SUBROUTINE test_genprop_basic_class(total_error)
cid1 = 456
CALL H5Pget_class_name_f(cid1, name, size, error)
- CALL VERIFY("H5Pget_class_name", error, -1, error)
+ CALL verify("H5Pget_class_name", error, -1, error)
! Create a new generic class, derived from the root of the class hierarchy
CALL H5Pcreate_class_f(H5P_ROOT_F, CLASS1_NAME, cid1, error)
@@ -126,8 +125,8 @@ SUBROUTINE test_genprop_basic_class(total_error)
! Check class name
CALL H5Pget_class_name_f(cid1, name, size, error)
CALL check("H5Pget_class_name", error, total_error)
- CALL VERIFY("H5Pget_class_name", size,7,error)
- CALL verifystring("H5Pget_class_name", name, CLASS1_NAME, error)
+ CALL verify("H5Pget_class_name", size,7,error)
+ CALL verify("H5Pget_class_name", name, CLASS1_NAME, error)
IF(error.NE.0)THEN
WRITE(*,*) 'Class names do not match! name=',name, 'CLASS1_NAME=',CLASS1_NAME
total_error = total_error + 1
@@ -136,8 +135,8 @@ SUBROUTINE test_genprop_basic_class(total_error)
! Check class name smaller buffer
CALL H5Pget_class_name_f(cid1, name_small, size, error)
CALL check("H5Pget_class_name", error, total_error)
- CALL VERIFY("H5Pget_class_name", size,7,error)
- CALL verifystring("H5Pget_class_name", name_small(1:4), CLASS1_NAME(1:4), error)
+ CALL verify("H5Pget_class_name", size,7,error)
+ CALL verify("H5Pget_class_name", name_small(1:4), CLASS1_NAME(1:4), error)
IF(error.NE.0)THEN
WRITE(*,*) 'Class names do not match! name=',name_small(1:4), 'CLASS1_NAME=',CLASS1_NAME(1:4)
total_error = total_error + 1
@@ -146,8 +145,8 @@ SUBROUTINE test_genprop_basic_class(total_error)
! Check class name bigger buffer
CALL H5Pget_class_name_f(cid1, name_big, size, error)
CALL check("H5Pget_class_name", error, total_error)
- CALL VERIFY("H5Pget_class_name", size,7,error)
- CALL verifystring("H5Pget_class_name", TRIM(name_big), TRIM(CLASS1_NAME), error)
+ CALL verify("H5Pget_class_name", size,7,error)
+ CALL verify("H5Pget_class_name", TRIM(name_big), TRIM(CLASS1_NAME), error)
IF(error.NE.0)THEN
WRITE(*,*) 'Class names do not match! name=',TRIM(name_small), 'CLASS1_NAME=',TRIM(CLASS1_NAME)
total_error = total_error + 1
@@ -160,13 +159,13 @@ SUBROUTINE test_genprop_basic_class(total_error)
! Verify class parent correct
CALL H5Pequal_f(cid2, H5P_ROOT_F, flag, error)
CALL check("H5Pequal_f", error, total_error)
- CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Pequal_f", flag, .TRUE., total_error)
! Make certain false postives aren't being returned
CALL H5Pequal_f(cid2, H5P_FILE_CREATE_F, flag, error)
CALL check("H5Pequal_f", error, total_error)
- CALL verifylogical("H5Pequal_f", flag, .FALSE., total_error)
+ CALL verify("H5Pequal_f", flag, .FALSE., total_error)
! Close parent class
CALL H5Pclose_class_f(cid2, error)
@@ -187,8 +186,6 @@ SUBROUTINE test_h5s_encode(total_error)
!**
!***************************************************************
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -241,7 +238,7 @@ SUBROUTINE test_h5s_encode(total_error)
! Try decoding bogus buffer
CALL H5Sdecode_f(sbuf, decoded_sid1, error)
- CALL VERIFY("H5Sdecode", error, -1, total_error)
+ CALL verify("H5Sdecode", error, -1, total_error)
CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
CALL check("H5Sencode", error, total_error)
@@ -254,7 +251,7 @@ SUBROUTINE test_h5s_encode(total_error)
! Verify the decoded dataspace
CALL h5sget_simple_extent_npoints_f(decoded_sid1, n, error)
CALL check("h5sget_simple_extent_npoints_f", error, total_error)
- CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), INT(SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3), &
+ CALL verify("h5sget_simple_extent_npoints_f", INT(n), INT(SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3), &
total_error)
!
@@ -297,16 +294,16 @@ SUBROUTINE test_h5s_encode(total_error)
CALL H5Sget_simple_extent_type_f(decoded_sid3, space_type, error)
CALL check("H5Sget_simple_extent_type_f", error, total_error)
- CALL VERIFY("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error)
+ CALL verify("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error)
! Verify decoded dataspace
CALL h5sget_simple_extent_npoints_f(decoded_sid3, n, error)
CALL check("h5sget_simple_extent_npoints_f", error, total_error)
- CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), 1, total_error)
+ CALL verify("h5sget_simple_extent_npoints_f", INT(n), 1, total_error)
CALL H5Sget_simple_extent_ndims_f(decoded_sid3, rank, error)
CALL CHECK("H5Sget_simple_extent_ndims_f", error, total_error)
- CALL VERIFY("H5Sget_simple_extent_ndims_f", rank, 0, total_error )
+ CALL verify("H5Sget_simple_extent_ndims_f", rank, 0, total_error )
CALL h5sclose_f(sid3, error)
CALL check("h5sclose_f", error, total_error)
@@ -335,8 +332,6 @@ END SUBROUTINE test_h5s_encode
SUBROUTINE test_scaleoffset(cleanup, total_error )
- USE HDF5
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90
index 99d4c22..51e1d64 100644
--- a/fortran/test/tH5O.f90
+++ b/fortran/test/tH5O.f90
@@ -28,11 +28,13 @@
!*****
MODULE TH5O
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE test_h5o(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -57,9 +59,6 @@ END SUBROUTINE test_h5o
SUBROUTINE test_h5o_link(total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -157,7 +156,7 @@ SUBROUTINE test_h5o_link(total_error)
CALL H5Tcommitted_f(type_id, committed, error)
CALL check("H5Tcommitted_f",error,total_error)
- CALL verifyLogical("H5Tcommitted_f", committed, .TRUE., total_error)
+ CALL verify("H5Tcommitted_f", committed, .TRUE., total_error)
! Create a dataset with no name using the committed datatype
CALL H5Dcreate_anon_f(file_id, type_id, space_id, dset_id, error ) ! using no optional parameters
@@ -181,7 +180,7 @@ SUBROUTINE test_h5o_link(total_error)
! Verify the data
DO i = 1, TEST6_DIM1
DO j = 1, TEST6_DIM2
- CALL VERIFY("H5Dread_f",wdata(i,j),rdata(i,j),total_error)
+ CALL verify("H5Dread_f",wdata(i,j),rdata(i,j),total_error)
wdata(i,j) = i*j
ENDDO
ENDDO
@@ -229,7 +228,7 @@ SUBROUTINE test_h5o_link(total_error)
! Verify the data
DO i = 1, TEST6_DIM1
DO j = 1, TEST6_DIM2
- CALL VERIFY("H5Dread",wdata(i,j),rdata(i,j),total_error)
+ CALL verify("H5Dread",wdata(i,j),rdata(i,j),total_error)
ENDDO
ENDDO
! Close open IDs
@@ -464,7 +463,7 @@ SUBROUTINE test_h5o_link(total_error)
nlinks = 0
CALL h5pget_nlinks_f(plist, nlinks, error)
CALL check("h5pget_nlinks_f",error,total_error)
- CALL VERIFY("h5pget_nlinks_f", INT(nlinks), 2, total_error)
+ CALL verify("h5pget_nlinks_f", INT(nlinks), 2, total_error)
! See if the link exists
CALL h5oexists_by_name_f(file_id,"/G1_LINK", link_exists, error, plist)
@@ -578,9 +577,6 @@ END SUBROUTINE test_h5o_link
SUBROUTINE test_h5o_plist(total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -631,18 +627,18 @@ SUBROUTINE test_h5o_plist(total_error)
! Retrieve attribute phase change values on each creation property list and verify
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(tcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
! Create a group, dataset, and committed datatype within the file,
! using the respective type of creation property lists.
@@ -700,18 +696,18 @@ SUBROUTINE test_h5o_plist(total_error)
! Retrieve attribute phase change values on each creation property list and verify
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(tcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
! Close current objects
CALL h5pclose_f(gcpl,error)
@@ -757,18 +753,18 @@ SUBROUTINE test_h5o_plist(total_error)
! Retrieve attribute phase change values on each creation property list and verify
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(tcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
! Close current objects
CALL h5pclose_f(gcpl,error)
diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90
index 7dcc580..39d8c1e 100644
--- a/fortran/test/tH5P.f90
+++ b/fortran/test/tH5P.f90
@@ -27,6 +27,9 @@
!
!*****
MODULE TH5P
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
CONTAINS
@@ -36,8 +39,6 @@ SUBROUTINE external_test(cleanup, total_error)
! h5pset_external_f, h5pget_external_count_f,
! h5pget_external_f
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -153,8 +154,6 @@ SUBROUTINE external_test(cleanup, total_error)
END SUBROUTINE external_test
SUBROUTINE multi_file_test(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -421,10 +420,7 @@ END SUBROUTINE multi_file_test
! April 16, 2009
!-------------------------------------------------------------------------
!
-SUBROUTINE test_chunk_cache(cleanup, total_error)
-
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
+SUBROUTINE test_chunk_cache(cleanup, total_error)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -470,19 +466,16 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_cache_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl1, nslots_4, nbytes_4, w0_4, error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_1), INT(nslots_4), total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_1), INT(nbytes_4), total_error)
-
- IF( .NOT.dreal_eq( REAL(w0_1,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ CALL verify("H5Pget_chunk_cache_f", nslots_1, nslots_4, total_error)
+ CALL verify("H5Pget_chunk_cache_f", nbytes_1, nbytes_4, total_error)
+ CALL verify("H5Pget_chunk_cache_f", w0_1, w0_4, total_error)
! Set a lapl property on dapl1 (to verify inheritance)
CALL H5Pset_nlinks_f(dapl1, 134_size_t , error)
CALL check("H5Pset_nlinks_f", error, total_error)
CALL H5Pget_nlinks_f(dapl1, nlinks, error)
CALL check("H5Pget_nlinks_f", error, total_error)
- CALL VERIFY("H5Pget_nlinks_f", INT(nlinks), 134, total_error)
+ CALL verify("H5Pget_nlinks_f", INT(nlinks), 134, total_error)
CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_local, error)
@@ -529,11 +522,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Dget_access_plist_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ CALL verify("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", w0_2, w0_4, total_error)
CALL H5Pclose_f(dapl2,error)
CALL check("H5Pclose_f", error, total_error)
@@ -561,11 +552,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Dget_access_plist_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.dreal_eq( REAL(w0_3,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f4", .TRUE., .FALSE., total_error)
- ENDIF
+ CALL verify("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", w0_3, w0_4, total_error)
CALL H5Pclose_f(dapl2,error)
CALL check("H5Pclose_f", error, total_error)
@@ -581,11 +570,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Dget_access_plist_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ CALL verify("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", w0_2, w0_4, total_error)
CALL H5Pclose_f(dapl2,error)
CALL check("H5Pclose_f", error, total_error)
@@ -601,11 +588,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ CALL verify("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", w0_2, w0_4, total_error)
! Don't close dapl2, we will use it in the next section
! Modify cache values on fapl_local
@@ -638,11 +623,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Dget_access_plist_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ CALL verify("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", w0_2, w0_4, total_error)
! Test H5D_CHUNK_CACHE_NSLOTS_DEFAULT and H5D_CHUNK_CACHE_W0_DEFAULT
nslots_2 = H5D_CHUNK_CACHE_NSLOTS_DFLT_F
@@ -663,11 +646,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Dget_access_plist_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error)
- CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.dreal_eq( REAL(w0_3,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ CALL verify("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
+ CALL verify("H5Pget_chunk_cache_f", w0_3, w0_4, total_error)
! Close
diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90
index 56f9679..ec9fef2 100644
--- a/fortran/test/tH5P_F03.f90
+++ b/fortran/test/tH5P_F03.f90
@@ -52,8 +52,6 @@ CONTAINS
INTEGER FUNCTION test_genprop_cls_cb1_f(list_id, create_data ) bind(C)
- USE HDF5
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN), VALUE :: list_id
@@ -71,6 +69,11 @@ END MODULE test_genprop_cls_cb1_mod
MODULE TH5P_F03
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+ USE ISO_C_BINDING
+
CONTAINS
!-------------------------------------------------------------------------
@@ -92,9 +95,6 @@ CONTAINS
SUBROUTINE test_create(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -187,18 +187,12 @@ SUBROUTINE test_create(total_error)
CALL check("H5Pset_fill_value_f",error, total_error)
CALL h5pget_fill_value_f(dcpl, H5T_NATIVE_DOUBLE, dpfill, error)
CALL check("H5Pget_fill_value_f",error, total_error)
- IF(.NOT.dreal_eq( REAL(dpfill,dp), 1.0_dp))THEN
- PRINT*,"***ERROR: Returned wrong fill value (double)"
- total_error = total_error + 1
- ENDIF
+ CALL VERIFY("***ERROR: Returned wrong fill value (double)", dpfill, 1.0_dp, total_error)
CALL H5Pset_fill_value_f(dcpl, H5T_NATIVE_REAL, 2.0, error)
CALL check("H5Pset_fill_value_f",error, total_error)
CALL h5pget_fill_value_f(dcpl, H5T_NATIVE_REAL, rfill, error)
CALL check("H5Pget_fill_value_f",error, total_error)
- IF(.NOT.dreal_eq( REAL(rfill,dp), REAL(2.0,dp)))THEN
- PRINT*,"***ERROR: Returned wrong fill value (real)"
- total_error = total_error + 1
- ENDIF
+ CALL VERIFY("***ERROR: Returned wrong fill value (real)", rfill, 2.0, total_error)
! For the actual compound type
CALL H5Pset_fill_value_f(dcpl, comp_type_id, f_ptr, error)
@@ -234,10 +228,10 @@ SUBROUTINE test_create(total_error)
CALL H5Pget_fill_value_f(dcpl, comp_type_id, f_ptr, error)
CALL check("H5Pget_fill_value_f", error, total_error)
+ CALL verify("***ERROR: Returned wrong fill value", rd_c%a, fill_ctype%a, total_error)
+ CALL verify("***ERROR: Returned wrong fill value", rd_c%y, fill_ctype%y, total_error)
- IF( .NOT.dreal_eq( REAL(rd_c%a,dp), REAL(fill_ctype%a, dp)) .OR. &
- .NOT.dreal_eq( REAL(rd_c%y,dp), REAL(fill_ctype%y, dp)) .OR. &
- rd_c%x .NE. fill_ctype%x .OR. &
+ IF( rd_c%x .NE. fill_ctype%x .OR. &
rd_c%z .NE. fill_ctype%z )THEN
PRINT*,"***ERROR: Returned wrong fill value"
@@ -269,9 +263,6 @@ SUBROUTINE test_genprop_class_callback(total_error)
!
!
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
USE test_genprop_cls_cb1_mod
IMPLICIT NONE
@@ -330,7 +321,7 @@ SUBROUTINE test_genprop_class_callback(total_error)
! Check the number of properties in class
CALL h5pget_nprops_f(cid1, nprops, error)
CALL check("h5pget_nprops_f", error, total_error)
- CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error)
+ CALL verify("h5pget_nprops_f", INT(nprops), 4, total_error)
! Initialize class callback structs
@@ -350,12 +341,12 @@ SUBROUTINE test_genprop_class_callback(total_error)
! Check that the list's class is correct
CALL H5Pequal_f(cid2, cid1, flag, error)
CALL check("H5Pequal_f", error, total_error)
- CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Pequal_f", flag, .TRUE., total_error)
! Check the class name
CALL H5Pget_class_name_f(cid2, CLASS1_NAME_BUF, CLASS1_NAME_SIZE, error)
CALL check("H5Pget_class_name_f", error, total_error)
- CALL verifystring("H5Pget_class_name_f", CLASS1_NAME_BUF, CLASS1_NAME, error)
+ CALL verify("H5Pget_class_name_f", CLASS1_NAME_BUF, CLASS1_NAME, error)
IF(error.NE.0)THEN
WRITE(*,*) 'Class names do not match! name=',CLASS1_NAME_BUF, 'CLASS1_NAME=',CLASS1_NAME
total_error = total_error + 1
@@ -365,42 +356,42 @@ SUBROUTINE test_genprop_class_callback(total_error)
CALL check("h5pclose_class_f", error, total_error)
! Verify that the creation callback occurred
- CALL VERIFY("h5pcreate_f", crt_cb_struct%count, 1, total_error)
- CALL VERIFY_INTEGER_HID_T("h5pcreate_f", crt_cb_struct%id, lid1, total_error)
+ CALL verify("h5pcreate_f", crt_cb_struct%count, 1, total_error)
+ CALL verify("h5pcreate_f", crt_cb_struct%id, lid1, total_error)
! Check the number of properties in list
CALL h5pget_nprops_f(lid1,nprops, error)
CALL check("h5pget_nprops_f", error, total_error)
- CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error)
+ CALL verify("h5pget_nprops_f", INT(nprops), 4, total_error)
! Create another property list from the class
CALL h5pcreate_f(cid1, lid2, error)
CALL check("h5pcreate_f", error, total_error)
! Verify that the creation callback occurred
- CALL VERIFY("h5pcreate_f", crt_cb_struct%count, 2, total_error)
- CALL VERIFY_INTEGER_HID_T("h5pcreate_f", crt_cb_struct%id, lid2, total_error)
+ CALL verify("h5pcreate_f", crt_cb_struct%count, 2, total_error)
+ CALL verify("h5pcreate_f", crt_cb_struct%id, lid2, total_error)
! Check the number of properties in list
CALL h5pget_nprops_f(lid2,nprops, error)
CALL check("h5pget_nprops_f", error, total_error)
- CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error)
+ CALL verify("h5pget_nprops_f", INT(nprops), 4, total_error)
! Close first list
CALL h5pclose_f(lid1, error);
CALL check("h5pclose_f", error, total_error)
! Verify that the close callback occurred
- CALL VERIFY("h5pcreate_f", cls_cb_struct%count, 1, total_error)
- CALL VERIFY_INTEGER_HID_T("h5pcreate_f", cls_cb_struct%id, lid1, total_error)
+ CALL verify("h5pcreate_f", cls_cb_struct%count, 1, total_error)
+ CALL verify("h5pcreate_f", cls_cb_struct%id, lid1, total_error)
! Close second list
CALL h5pclose_f(lid2, error);
CALL check("h5pclose_f", error, total_error)
! Verify that the close callback occurred
- CALL VERIFY("h5pcreate_f", cls_cb_struct%count, 2, total_error)
- CALL verify_INTEGER_HID_T("h5pcreate_f", cls_cb_struct%id, lid2, total_error)
+ CALL verify("h5pcreate_f", cls_cb_struct%count, 2, total_error)
+ CALL verify("h5pcreate_f", cls_cb_struct%id, lid2, total_error)
! Close class
CALL h5pclose_class_f(cid1, error)
@@ -423,8 +414,6 @@ END SUBROUTINE test_genprop_class_callback
SUBROUTINE test_h5p_file_image(total_error)
- USE HDF5
- USE TH5_MISC
USE, INTRINSIC :: iso_c_binding
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -475,11 +464,11 @@ SUBROUTINE test_h5p_file_image(total_error)
CALL check("h5pget_file_image_f", error, total_error)
! Check that sizes are the same, and that the buffers are identical but separate
- CALL VERIFY("h5pget_file_image_f", INT(temp_size), INT(size), total_error)
+ CALL verify("h5pget_file_image_f", INT(temp_size), INT(size), total_error)
! Verify the image data is correct
DO i = 1, count
- CALL VERIFY("h5pget_file_image_f", temp(i), buffer(i), total_error)
+ CALL verify("h5pget_file_image_f", temp(i), buffer(i), total_error)
ENDDO
END SUBROUTINE test_h5p_file_image
@@ -499,10 +488,6 @@ END SUBROUTINE test_h5p_file_image
!
SUBROUTINE external_test_offset(cleanup,total_error)
- USE ISO_C_BINDING
- USE TH5_MISC
- USE HDF5 ! This module contains all necessary modules
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
LOGICAL, INTENT(IN) :: cleanup
diff --git a/fortran/test/tH5R.f90 b/fortran/test/tH5R.f90
index fba9e25..ef392b4 100644
--- a/fortran/test/tH5R.f90
+++ b/fortran/test/tH5R.f90
@@ -33,11 +33,13 @@
!
MODULE TH5R
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE refobjtest(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
@@ -163,22 +165,22 @@ SUBROUTINE refobjtest(cleanup, total_error)
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),7, total_error)
- CALL VerifyString("H5Rget_name_f", buf, "/GROUP1", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),7, total_error)
+ CALL verify("H5Rget_name_f", buf, "/GROUP1", total_error)
! with buffer bigger then needed
CALL H5Rget_name_f(dsetr_id, ref(1), buf_big, error, buf_size )
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),7,total_error)
- CALL VerifyString("H5Rget_name_f", TRIM(buf_big), "/GROUP1", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),7,total_error)
+ CALL verify("H5Rget_name_f", TRIM(buf_big), "/GROUP1", total_error)
! getting path to dataset in /Group1
CALL H5Rget_name_f(dsetr_id, ref(2), buf_big, error, buf_size )
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),14,total_error)
- CALL VerifyString("H5Rget_name_f", TRIM(buf_big), "/GROUP1/GROUP2", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),14,total_error)
+ CALL verify("H5Rget_name_f", TRIM(buf_big), "/GROUP1/GROUP2", total_error)
!
!Close the dataset
@@ -242,9 +244,6 @@ END SUBROUTINE refobjtest
! and h5rdereference_f functionalities
!
SUBROUTINE refregtest(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-! use iso_c_binding ! NOTE: if this is uncommented, then need to move subroutine into another file.
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -406,23 +405,23 @@ SUBROUTINE refregtest(cleanup, total_error)
! Get name of the dataset the first region reference points to using H5Rget_name_f
CALL H5Rget_name_f(dsetr_id, ref_out(1), buf, error, buf_size )
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),7,total_error)
- CALL VerifyString("H5Rget_name_f", buf, "/MATRIX", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),7,total_error)
+ CALL verify("H5Rget_name_f", buf, "/MATRIX", total_error)
! Get name of the dataset the first region reference points to using H5Rget_name_f
! buffer bigger then needed
CALL H5Rget_name_f(dsetr_id, ref_out(1), buf_big, error, buf_size )
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),7,total_error)
- CALL VerifyString("H5Rget_name_f", TRIM(buf_big), "/MATRIX", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),7,total_error)
+ CALL verify("H5Rget_name_f", TRIM(buf_big), "/MATRIX", total_error)
! Get name of the dataset the first region reference points to using H5Rget_name_f
! buffer smaller then needed
CALL H5Rget_name_f(dsetr_id, ref_out(1), buf_small, error, buf_size )
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),7,total_error)
- CALL VerifyString("H5Rget_name_f", TRIM(buf_small), "/MAT", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),7,total_error)
+ CALL verify("H5Rget_name_f", TRIM(buf_small), "/MAT", total_error)
!
! Dereference the first reference.
!
@@ -434,7 +433,7 @@ SUBROUTINE refregtest(cleanup, total_error)
! Get name of the dataset the second region reference points to using H5Rget_name_f
CALL H5Rget_name_f(dsetr_id, ref_out(2), buf, error) ! no optional size
CALL check("H5Rget_name_f", error, total_error)
- CALL VerifyString("H5Rget_name_f", TRIM(buf), "/MATRIX", total_error)
+ CALL verify("H5Rget_name_f", TRIM(buf), "/MATRIX", total_error)
!
! Read selected data from the dataset.
!
diff --git a/fortran/test/tH5S.f90 b/fortran/test/tH5S.f90
index eaaf29a..7223772 100644
--- a/fortran/test/tH5S.f90
+++ b/fortran/test/tH5S.f90
@@ -35,12 +35,14 @@
!*****
MODULE TH5S
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE dataspace_basic_test(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
diff --git a/fortran/test/tH5Sselect.f90 b/fortran/test/tH5Sselect.f90
index 7d07308..10139ea 100644
--- a/fortran/test/tH5Sselect.f90
+++ b/fortran/test/tH5Sselect.f90
@@ -38,13 +38,14 @@
!*****
MODULE TH5SSELECT
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE test_select_hyperslab(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
@@ -699,8 +700,6 @@ CONTAINS
SUBROUTINE test_basic_select(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -1036,8 +1035,6 @@ CONTAINS
!***************************************************************
SUBROUTINE test_select_point(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -1140,9 +1137,9 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(1,i)), INT(coord1(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(2,i)), INT(coord1(2,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(3,i)), INT(coord1(3,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(1,i)), INT(coord1(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(2,i)), INT(coord1(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(3,i)), INT(coord1(3,i)), total_error)
ENDDO
CALL H5Sget_select_npoints_f(sid1, npoints, error)
@@ -1171,9 +1168,9 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(1,i)), INT(coord1(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(2,i)), INT(coord1(2,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(3,i)), INT(coord1(3,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(1,i)), INT(coord1(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(2,i)), INT(coord1(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(3,i)), INT(coord1(3,i)), total_error)
ENDDO
CALL H5Sget_select_npoints_f(sid1, npoints, error)
@@ -1202,8 +1199,8 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord2(1,i)), INT(coord2(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord2(2,i)), INT(coord2(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(1,i)), INT(coord2(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(2,i)), INT(coord2(2,i)), total_error)
ENDDO
!!$
@@ -1238,8 +1235,8 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord2(1,i)), INT(coord2(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord2(2,i)), INT(coord2(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(1,i)), INT(coord2(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(2,i)), INT(coord2(2,i)), total_error)
ENDDO
CALL H5Sget_select_npoints_f(sid2, npoints, error)
@@ -1284,8 +1281,8 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord3,error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord3(1,i)), INT(coord3(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord3(2,i)), INT(coord3(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(1,i)), INT(coord3(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(2,i)), INT(coord3(2,i)), total_error)
ENDDO
CALL H5Sget_select_npoints_f(sid2, npoints, error)
@@ -1311,8 +1308,8 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL h5sget_select_elem_pointlist_f(sid2, INT(POINT1_NPOINTS,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord3,error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord3(1,i)), INT(coord3(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord3(2,i)), INT(coord3(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(1,i)), INT(coord3(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(2,i)), INT(coord3(2,i)), total_error)
ENDDO
CALL H5Sget_select_npoints_f(sid2, npoints, error)
@@ -1363,8 +1360,6 @@ END SUBROUTINE test_select_point
!***************************************************************
SUBROUTINE test_select_combine(total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1400,7 +1395,7 @@ SUBROUTINE test_select_combine(total_error)
CALL H5Sget_select_type_f(all_id, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error)
! Copy base dataspace and set selection to "none"
CALL h5scopy_f(base_id, none_id, error)
@@ -1411,7 +1406,7 @@ SUBROUTINE test_select_combine(total_error)
CALL H5Sget_select_type_f(none_id, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_NONE_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_NONE_F), total_error)
! Copy "all" selection & space
CALL H5Scopy_f(all_id, space1, error)
@@ -1429,7 +1424,7 @@ SUBROUTINE test_select_combine(total_error)
! Verify that it's still "all" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1451,12 +1446,12 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the same at the original block
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there is only one block
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
! Retrieve the block defined
CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error)
@@ -1464,10 +1459,10 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the correct block is defined
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1490,12 +1485,12 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is an inversion of the original block
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there are two blocks
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error)
! Retrieve the block defined
@@ -1507,19 +1502,19 @@ SUBROUTINE test_select_combine(total_error)
! No guarantee is implied as the order in which blocks are listed.
! So this will ONLY work for square domains iblock(1:2) = (/5,5/)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 5, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 10, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(5,1,1)), 6, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(6,1,1)), 1, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(7,1,1)), 10, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(8,1,1)), 10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 5, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(5,1,1)), 6, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(6,1,1)), 1, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(7,1,1)), 10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(8,1,1)), 10, total_error)
! Otherwise make sure the "area" of the block is correct
area = (ABS(INT(blocks(1,1,1)-blocks(3,1,1)))+1)*(ABS(INT(blocks(2,1,1)-blocks(4,1,1)))+1)
area = area + (ABS(INT(blocks(5,1,1)-blocks(7,1,1)))+1)*(ABS(INT(blocks(6,1,1)-blocks(8,1,1)))+1)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", area, 80, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", area, 80, total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1542,12 +1537,12 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is an inversion of the original block
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there are two blocks
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error)
! Retrieve the block defined
blocks = -1 ! Reset block list
@@ -1559,19 +1554,19 @@ SUBROUTINE test_select_combine(total_error)
! No guarantee is implied as the order in which blocks are listed.
! So this will ONLY work for square domains iblock(1:2) = (/5,5/)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 5, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)),10, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(5,1,1)), 6, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(6,1,1)), 1, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(7,1,1)),10, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(8,1,1)),10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 5, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)),10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(5,1,1)), 6, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(6,1,1)), 1, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(7,1,1)),10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(8,1,1)),10, total_error)
! Otherwise make sure the "area" of the block is correct
area = (ABS(INT(blocks(1,1,1)-blocks(3,1,1)))+1)*(ABS(INT(blocks(2,1,1)-blocks(4,1,1)))+1)
area = area + (ABS(INT(blocks(5,1,1)-blocks(7,1,1)))+1)*(ABS(INT(blocks(6,1,1)-blocks(8,1,1)))+1)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", area, 80, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", area, 80, total_error)
! Close temporary dataspace
@@ -1594,7 +1589,7 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the "none" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1617,13 +1612,13 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the same as the original hyperslab
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there is only one block
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
! Retrieve the block defined
blocks = -1 ! Reset block list
@@ -1631,10 +1626,10 @@ SUBROUTINE test_select_combine(total_error)
CALL check("h5sget_select_hyper_blocklist_f", error, total_error)
! Verify that the correct block is defined
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1657,7 +1652,7 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the "none" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1680,23 +1675,23 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the same as the original hyperslab
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there is only one block
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
! Retrieve the block defined
blocks = -1 ! Reset block list
CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error)
CALL check("h5sget_select_hyper_blocklist_f", error, total_error)
! Verify that the correct block is defined
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1719,7 +1714,7 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the "none" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1741,12 +1736,12 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the same as the original hyperslab
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there is ONLY one BLOCK
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
! Retrieve the block defined
@@ -1757,10 +1752,10 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the correct block is defined
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1785,8 +1780,6 @@ END SUBROUTINE test_select_combine
!***************************************************************
SUBROUTINE test_select_bounds(total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1817,10 +1810,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), SPACE11_DIM1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), SPACE11_DIM2, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(1)), 1, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(1)), SPACE11_DIM1, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(2)), SPACE11_DIM2, total_error)
! Set offset for selection
offset(1:2) = 1
@@ -1847,7 +1840,7 @@ SUBROUTINE test_select_bounds(total_error)
! Get bounds for 'none' selection, should fail
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
- CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
+ CALL verify("h5sget_select_bounds_f", error, -1, total_error)
! Set point selection
@@ -1863,10 +1856,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-4), total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-4), total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(1)), 3, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(2)), 3, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-4), total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-4), total_error)
! Set bad offset for selection
@@ -1876,7 +1869,7 @@ SUBROUTINE test_select_bounds(total_error)
! Get bounds for hyperslab selection with negative offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
- CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
+ CALL verify("h5sget_select_bounds_f", error, -1, total_error)
! Set valid offset for selection
offset(1:2) = (/2,-2/)
@@ -1887,10 +1880,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 5, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-2), total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-6), total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(1)), 5, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-2), total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-6), total_error)
! Reset offset for selection
offset(1:2) = 0
@@ -1911,10 +1904,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 37, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 37, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(1)), 3, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(2)), 3, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(1)), 37, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(2)), 37, total_error)
! Set bad offset for selection
offset(1:2) = (/5,-5/)
@@ -1923,7 +1916,7 @@ SUBROUTINE test_select_bounds(total_error)
! Get bounds for hyperslab selection with negative offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
- CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
+ CALL verify("h5sget_select_bounds_f", error, -1, total_error)
! Set valid offset for selection
offset(1:2) = (/5,-2/)
@@ -1934,10 +1927,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 8, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 42, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 35, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(1)), 8, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(1)), 42, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(2)), 35, total_error)
! Reset offset for selection
offset(1:2) = 0
@@ -1958,10 +1951,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 50, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 50, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(1)), 3, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(2)), 3, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(1)), 50, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(2)), 50, total_error)
! Set bad offset for selection
offset(1:2) = (/5,-5/)
@@ -1970,7 +1963,7 @@ SUBROUTINE test_select_bounds(total_error)
! Get bounds for hyperslab selection with negative offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
- CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
+ CALL verify("h5sget_select_bounds_f", error, -1, total_error)
! Set valid offset for selection
offset(1:2) = (/5,-2/)
@@ -1981,10 +1974,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 8, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 55, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 48, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(1)), 8, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(1)), 55, total_error)
+ CALL verify("h5sget_select_bounds_f", INT(high_bounds(2)), 48, total_error)
! Reset offset for selection
offset(1:2) = 0
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index 761dfcb..9aaaa73 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -29,6 +29,10 @@
MODULE TH5T
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE compoundtest(cleanup, total_error)
@@ -47,8 +51,6 @@ CONTAINS
! h5tget_class_f, h5tget_member_name_f, h5tget_member_offset_f, h5tget_member_type_f,
! h5tequal_f, h5tinsert_array_f, h5tcommit_f, h5tencode_f, h5tdecode_f
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -526,12 +528,9 @@ CONTAINS
!
CALL h5dread_f(dset_id, dt3_id, double_member_out, data_dims, error)
CALL check("h5dread_f", error, total_error)
- do i = 1, dimsize
- IF( .NOT.dreal_eq( REAL(double_member_out(i),dp), REAL( double_member(i), dp)) ) THEN
- write(*,*) " Wrong double precision data is read back "
- total_error = total_error + 1
- endif
- enddo
+ DO i = 1, dimsize
+ CALL VERIFY("h5dread_f:Wrong double precision data is read back", double_member_out(i), double_member(i), total_error)
+ ENDDO
!
!
CALL h5tcreate_f(H5T_COMPOUND_F, type_sizer, dt4_id, error)
@@ -544,12 +543,9 @@ CONTAINS
!
CALL h5dread_f(dset_id, dt4_id, real_member_out, data_dims, error)
CALL check("h5dread_f", error, total_error)
- DO i = 1, dimsize
- IF( .NOT.dreal_eq( REAL(real_member_out(i),dp), REAL( real_member(i), dp)) ) THEN
- WRITE(*,*) " Wrong real precision data is read back "
- total_error = total_error + 1
- ENDIF
- ENDDO
+ DO i = 1, dimsize
+ CALL VERIFY("h5dread_f:Wrong double precision data is read back", real_member_out(i), real_member(i), total_error)
+ ENDDO
!
! *-----------------------------------------------------------------------
! * Test encoding and decoding compound datatypes
@@ -564,7 +560,7 @@ CONTAINS
! Try decoding bogus buffer
CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error)
- CALL VERIFY("H5Tdecode_f", error, -1, total_error)
+ CALL verify("H5Tdecode_f", error, -1, total_error)
CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error)
CALL check("H5Tencode_f", error, total_error)
@@ -577,7 +573,7 @@ CONTAINS
CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Tequal_f", flag, .TRUE., total_error)
!
! Close all open objects.
!
@@ -613,9 +609,6 @@ CONTAINS
! H5tset_norm_f, H5tget_inpad_f, H5tset_inpad_f, H5tget_cset_f,
! H5tset_cset_f, H5tget_strpad_f, H5tset_strpad_f
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(OUT) :: total_error
@@ -901,7 +894,7 @@ CONTAINS
CALL check("H5Tget_order_f",error, total_error)
CALL H5Tget_order_f(H5T_NATIVE_INTEGER, order2, error)
CALL check("H5Tget_order_f",error, total_error)
- CALL VERIFY("H5Tget_native_type_f",order1, order2, total_error)
+ CALL verify("H5Tget_native_type_f",order1, order2, total_error)
! this test depends on whether -i8 was specified
@@ -909,11 +902,11 @@ CONTAINS
!!$ CALL check("H5Tget_size_f",error, total_error)
!!$ CALL H5Tget_size_f(H5T_STD_I32BE, type_size2, error)
!!$ CALL check("H5Tget_size_f",error, total_error)
-!!$ CALL VERIFY("H5Tget_native_type_f", INT(type_size1), INT(type_size2), total_error)
+!!$ CALL verify("H5Tget_native_type_f", INT(type_size1), INT(type_size2), total_error)
CALL H5Tget_class_f(native_type, class, error)
CALL check("H5Tget_class_f",error, total_error)
- CALL VERIFY("H5Tget_native_type_f", INT(class), INT(H5T_ENUM_F), total_error)
+ CALL verify("H5Tget_native_type_f", INT(class), INT(H5T_ENUM_F), total_error)
CALL h5dclose_f(dset_id,error)
CALL check("h5dclose_f", error, total_error)
@@ -971,8 +964,6 @@ CONTAINS
SUBROUTINE test_derived_flt(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -1059,24 +1050,24 @@ SUBROUTINE test_derived_flt(cleanup, total_error)
CALL check("H5Tget_fields_f", error, total_error)
IF(spos.NE.44 .OR. epos.NE.34 .OR. esize.NE.10 .OR. mpos.NE.3 .OR. msize.NE.31)THEN
- CALL VERIFY("H5Tget_fields_f", -1, 0, total_error)
+ CALL verify("H5Tget_fields_f", -1, 0, total_error)
ENDIF
CALL H5Tget_precision_f(tid1, precision1, error)
CALL check("H5Tget_precision_f", error, total_error)
- CALL VERIFY("H5Tget_precision_f", INT(precision1), 42, total_error)
+ CALL verify("H5Tget_precision_f", INT(precision1), 42, total_error)
CALL H5Tget_offset_f(tid1, offset1, error)
CALL check("H5Tget_offset_f", error, total_error)
- CALL VERIFY("H5Tget_offset_f", INT(offset1), 3, total_error)
+ CALL verify("H5Tget_offset_f", INT(offset1), 3, total_error)
CALL H5Tget_size_f(tid1, size1, error)
CALL check("H5Tget_size_f", error, total_error)
- CALL VERIFY("H5Tget_size_f", INT(size1), 7, total_error)
+ CALL verify("H5Tget_size_f", INT(size1), 7, total_error)
CALL H5Tget_ebias_f(tid1, ebias1, error)
CALL check("H5Tget_ebias_f", error, total_error)
- CALL VERIFY("H5Tget_ebias_f", INT(ebias1), 511, total_error)
+ CALL verify("H5Tget_ebias_f", INT(ebias1), 511, total_error)
!--------------------------------------------------------------------------
! * 2nd floating-point type
@@ -1120,24 +1111,24 @@ SUBROUTINE test_derived_flt(cleanup, total_error)
CALL check("H5Tget_fields_f", error, total_error)
IF(spos.NE.23 .OR. epos.NE.16 .OR. esize.NE.7 .OR. mpos.NE.0 .OR. msize.NE.16)THEN
- CALL VERIFY("H5Tget_fields_f", -1, 0, total_error)
+ CALL verify("H5Tget_fields_f", -1, 0, total_error)
ENDIF
CALL H5Tget_precision_f(tid2, precision2, error)
CALL check("H5Tget_precision_f", error, total_error)
- CALL VERIFY("H5Tget_precision_f", INT(precision2), 24, total_error)
+ CALL verify("H5Tget_precision_f", INT(precision2), 24, total_error)
CALL H5Tget_offset_f(tid2, offset2, error)
CALL check("H5Tget_offset_f", error, total_error)
- CALL VERIFY("H5Tget_offset_f", INT(offset2), 0, total_error)
+ CALL verify("H5Tget_offset_f", INT(offset2), 0, total_error)
CALL H5Tget_size_f(tid2, size2, error)
CALL check("H5Tget_size_f", error, total_error)
- CALL VERIFY("H5Tget_size_f", INT(size2), 3, total_error)
+ CALL verify("H5Tget_size_f", INT(size2), 3, total_error)
CALL H5Tget_ebias_f(tid2, ebias2, error)
CALL check("H5Tget_ebias_f", error, total_error)
- CALL VERIFY("H5Tget_ebias_f", INT(ebias2), 63, total_error)
+ CALL verify("H5Tget_ebias_f", INT(ebias2), 63, total_error)
CALL h5tclose_f(tid1, error)
CALL check("h5tclose_f", error, total_error)
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.F90
index 5cac62d..8117578 100644
--- a/fortran/test/tH5T_F03.f90
+++ b/fortran/test/tH5T_F03.F90
@@ -45,15 +45,14 @@
MODULE TH5T_F03
USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
USE ISO_C_BINDING
CONTAINS
SUBROUTINE test_array_compound_atomic(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -201,7 +200,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
! Check the 1st field's name
CALL H5Tget_member_name_f(tid2, 0, mname, namelen,error)
CALL check("H5Tget_member_name_f", error, total_error)
- CALL verifystring("H5Tget_member_name_f",mname(1:namelen),"i", total_error)
+ CALL verify("H5Tget_member_name_f",mname(1:namelen),"i", total_error)
! Check the 1st field's offset
CALL H5Tget_member_offset_f(tid2, 0, off, error)
@@ -215,7 +214,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
CALL H5Tequal_f(mtid, H5T_NATIVE_INTEGER, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Tequal_f", flag, .TRUE., total_error)
CALL h5tclose_f(mtid,error)
CALL check("h5tclose_f", error, total_error)
@@ -223,7 +222,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
! Check the 2nd field's name
CALL H5Tget_member_name_f(tid2, 1, mname, namelen,error)
CALL check("H5Tget_member_name_f", error, total_error)
- CALL verifystring("H5Tget_member_name_f",mname(1:namelen),"f", total_error)
+ CALL verify("H5Tget_member_name_f",mname(1:namelen),"f", total_error)
! Check the 2nd field's offset
CALL H5Tget_member_offset_f(tid2, 1, off, error)
@@ -236,7 +235,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
CALL H5Tequal_f(mtid, H5T_NATIVE_REAL, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Tequal_f", flag, .TRUE., total_error)
CALL h5tclose_f(mtid,error)
CALL check("h5tclose_f", error, total_error)
@@ -258,10 +257,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( .NOT.dreal_eq( REAL(wdata(i,j)%f,dp), REAL( rdata(i,j)%f, dp)) ) THEN
- PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
+ CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',wdata(i,j)%f, rdata(i,j)%f, total_error)
ENDDO
ENDDO
@@ -288,9 +284,6 @@ END SUBROUTINE test_array_compound_atomic
!!$
SUBROUTINE test_array_compound_array(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -487,7 +480,7 @@ END SUBROUTINE test_array_compound_atomic
! Check the 1st field's name
CALL H5Tget_member_name_f(tid2, 0, mname, namelen,error)
CALL check("H5Tget_member_name_f", error, total_error)
- CALL verifystring("H5Tget_member_name_f",mname(1:namelen),"i", total_error)
+ CALL verify("H5Tget_member_name_f",mname(1:namelen),"i", total_error)
! Check the 1st field's offset
@@ -501,7 +494,7 @@ END SUBROUTINE test_array_compound_atomic
CALL H5Tequal_f(mtid, H5T_NATIVE_INTEGER, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Tequal_f", flag, .TRUE., total_error)
CALL h5tclose_f(mtid,error)
CALL check("h5tclose_f", error, total_error)
@@ -509,7 +502,7 @@ END SUBROUTINE test_array_compound_atomic
! Check the 2nd field's name
CALL H5Tget_member_name_f(tid2, 1, mname, namelen,error)
CALL check("H5Tget_member_name_f", error, total_error)
- CALL verifystring("H5Tget_member_name_f",mname(1:namelen),"f", total_error)
+ CALL verify("H5Tget_member_name_f",mname(1:namelen),"f", total_error)
! Check the 2nd field's offset
CALL H5Tget_member_offset_f(tid2, 1, off, error)
@@ -542,7 +535,7 @@ END SUBROUTINE test_array_compound_atomic
! Check the 3rd field's name
CALL H5Tget_member_name_f(tid2, 2, mname, namelen,error)
CALL check("H5Tget_member_name_f", error, total_error)
- CALL verifystring("H5Tget_member_name_f",mname(1:namelen),"c", total_error)
+ CALL verify("H5Tget_member_name_f",mname(1:namelen),"c", total_error)
! Check the 3rd field's offset
CALL H5Tget_member_offset_f(tid2, 2, off, error)
@@ -579,7 +572,7 @@ END SUBROUTINE test_array_compound_atomic
CALL H5Tequal_f(tid3, H5T_NATIVE_REAL, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Tequal_f", flag, .TRUE., total_error)
! Check the nested array's datatype
CALL H5Tget_super_f(mtid2, tid3, error)
@@ -587,7 +580,7 @@ END SUBROUTINE test_array_compound_atomic
CALL H5Tequal_f(tid3, atype_id, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Tequal_f", flag, .TRUE., total_error)
! Close the array's base type datatype
CALL h5tclose_f(tid3, error)
@@ -656,9 +649,6 @@ END SUBROUTINE test_array_compound_atomic
!!$
SUBROUTINE test_array_bkg(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -828,14 +818,8 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( .NOT.dreal_eq( REAL(cf(i)%b(j),dp), REAL( cfr(i)%b(j), dp)) ) THEN
- PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
- IF( .NOT.dreal_eq( REAL(cf(i)%c(j),dp), REAL( cfr(i)%c(j), dp)) ) THEN
- PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
+ CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',cf(i)%b(j), cfr(i)%b(j), total_error)
+ CALL VERIFY('ERROR: Wrong double data is read back by H5Dread_f ',cf(i)%c(j), cfr(i)%c(j), total_error)
ENDDO
ENDDO
@@ -895,10 +879,7 @@ END SUBROUTINE test_array_compound_atomic
DO i = 1, LENGTH
DO j = 1, ALEN
- IF( .NOT.dreal_eq( REAL(fld(i)%b(j),dp), REAL( fldr(i)%b(j), dp)) ) THEN
- PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
+ CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',fld(i)%b(j), fldr(i)%b(j), total_error)
ENDDO
ENDDO
CALL h5tclose_f(TYPE,error)
@@ -922,18 +903,9 @@ END SUBROUTINE test_array_compound_atomic
DO i = 1, LENGTH
DO j = 1, ALEN
- IF( cf(i)%a(j) .NE. cfr(i)%a(j) )THEN
- PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
- IF( .NOT.dreal_eq( REAL(cf(i)%b(j),dp), REAL(cfr(i)%b(j), dp)) ) THEN
- PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
- IF( .NOT.dreal_eq( REAL(cf(i)%c(j),dp), REAL(cfr(i)%c(j), dp)) ) THEN
- PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
+ CALL VERIFY('ERROR: Wrong integer data is read back by H5Dread_f ',cf(i)%a(j), cfr(i)%a(j), total_error)
+ CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',cf(i)%b(j),cfr(i)%b(j), total_error)
+ CALL VERIFY('ERROR: Wrong double data is read back by H5Dread_f ',cf(i)%c(j), cfr(i)%c(j), total_error)
ENDDO
ENDDO
@@ -980,18 +952,9 @@ END SUBROUTINE test_array_compound_atomic
DO i = 1, LENGTH
DO j = 1, ALEN
- IF( cf(i)%a(j) .NE. cfr(i)%a(j) )THEN
- PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
- IF( .NOT.dreal_eq( REAL(cf(i)%b(j),dp), REAL(cfr(i)%b(j), dp)) ) THEN
- PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
- IF( .NOT.dreal_eq( REAL(cf(i)%c(j),dp), REAL(cfr(i)%c(j), dp)) ) THEN
- PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
+ CALL VERIFY('ERROR: Wrong integer data is read back by H5Dread_f ',cf(i)%a(j), cfr(i)%a(j), total_error)
+ CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',cf(i)%b(j),cfr(i)%b(j), total_error)
+ CALL VERIFY('ERROR: Wrong double data is read back by H5Dread_f ',cf(i)%c(j), cfr(i)%c(j), total_error)
ENDDO
ENDDO
@@ -1010,22 +973,35 @@ END SUBROUTINE test_array_compound_atomic
SUBROUTINE test_h5kind_to_type(total_error)
- USE ISO_C_BINDING
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
- INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(Fortran_INTEGER_1) !should map to INTEGER*1 on most modern processors
- INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(Fortran_INTEGER_2) !should map to INTEGER*2 on most modern processors
- INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) !should map to INTEGER*4 on most modern processors
- INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(Fortran_INTEGER_8) !should map to INTEGER*8 on most modern processors
-
+! INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(Fortran_INTEGER_1) !should map to INTEGER*1 on most modern processors
+! INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(Fortran_INTEGER_2) !should map to INTEGER*2 on most modern processors
+! INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) !should map to INTEGER*4 on most modern processors
+! INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(Fortran_INTEGER_8) !should map to INTEGER*8 on most modern processors
+
+ INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(2) !should map to INTEGER*1 on most modern processors
+ INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(4) !should map to INTEGER*2 on most modern processors
+ INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors
+ INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(18) !should map to INTEGER*8 on most modern processors
+!#ifdef
+ INTEGER, PARAMETER :: int_kind_32 = SELECTED_INT_KIND(36) !should map to INTEGER*16 on most modern processors
+ INTEGER(int_kind_32), DIMENSION(1:4), TARGET :: dset_data_i32, data_out_i32
+ INTEGER(HID_T) :: dset_id32 ! Dataset identifier
+ CHARACTER(LEN=6), PARAMETER :: dsetname16 = "dset16" ! Dataset name
+!#endif
INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_C_FLOAT) !should map to REAL*4 on most modern processors
INTEGER, PARAMETER :: real_kind_15 = SELECTED_REAL_KIND(Fortran_REAL_C_DOUBLE) !should map to REAL*8 on most modern processors
+!#ifdef
+ INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(31)
+ REAL(real_kind_31), DIMENSION(1:4), TARGET :: dset_data_r31, data_out_r31
+ INTEGER(HID_T) :: dset_idr16 ! Dataset identifier
+ CHARACTER(LEN=7), PARAMETER :: dsetnamer16 = "dsetr16" ! Dataset name
+
+!#endif
CHARACTER(LEN=12), PARAMETER :: filename = "dsetf_F03.h5" ! File name
CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
@@ -1067,14 +1043,19 @@ END SUBROUTINE test_array_compound_atomic
! Initialize the dset_data array.
!
DO i = 1, 4
- dset_data_i1(i) = i
- dset_data_i4(i) = i
- dset_data_i8(i) = i
- dset_data_i16(i) = i
-
+ dset_data_i1(i) = 2**(4)-i
+ dset_data_i4(i) = 2**(10)-i
+ dset_data_i8(i) = 2**(28)-i
+ dset_data_i16(i) = 2**(28)-i
+!#ifdef
+ dset_data_i32(i) = 2**(28)-i
+!#endif
dset_data_r(i) = (i)*100.
dset_data_r7(i) = (i)*100.
dset_data_r15(i) = (i)*1000.
+!#ifdef
+ dset_data_r31(i) = 3.141592653589793238462643383279_real_kind_31
+!#endif
END DO
@@ -1096,14 +1077,20 @@ END SUBROUTINE test_array_compound_atomic
CALL check("H5Dcreate_f",error, total_error)
CALL H5Dcreate_f(file_id, dsetname8, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), dspace_id, dset_id16, error)
CALL check("H5Dcreate_f",error, total_error)
-
+!#ifdef
+ CALL H5Dcreate_f(file_id, dsetname16, h5kind_to_type(int_kind_32,H5_INTEGER_KIND), dspace_id, dset_id32, error)
+ CALL check("H5Dcreate_f",error, total_error)
+!#endif
CALL H5Dcreate_f(file_id, dsetnamer, H5T_NATIVE_REAL, dspace_id, dset_idr, error)
CALL check("H5Dcreate_f",error, total_error)
CALL H5Dcreate_f(file_id, dsetnamer4, h5kind_to_type(real_kind_7,H5_REAL_KIND), dspace_id, dset_idr4, error)
CALL check("H5Dcreate_f",error, total_error)
CALL H5Dcreate_f(file_id, dsetnamer8, h5kind_to_type(real_kind_15,H5_REAL_KIND), dspace_id, dset_idr8, error)
CALL check("H5Dcreate_f",error, total_error)
-
+!#ifdef
+ CALL H5Dcreate_f(file_id, dsetnamer16, h5kind_to_type(real_kind_31,H5_REAL_KIND), dspace_id, dset_idr16, error)
+ CALL check("H5Dcreate_f",error, total_error)
+!#endif
!
! Write the dataset.
!
@@ -1119,6 +1106,11 @@ END SUBROUTINE test_array_compound_atomic
f_ptr = C_LOC(dset_data_i16(1))
CALL h5dwrite_f(dset_id16, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), f_ptr, error)
CALL check("H5Dwrite_f",error, total_error)
+!#ifdef
+ f_ptr = C_LOC(dset_data_i32(1))
+ CALL h5dwrite_f(dset_id32, h5kind_to_type(int_kind_32,H5_INTEGER_KIND), f_ptr, error)
+ CALL check("H5Dwrite_f",error, total_error)
+!#endif
f_ptr = C_LOC(dset_data_r(1))
CALL h5dwrite_f(dset_idr, H5T_NATIVE_REAL, f_ptr, error)
CALL check("H5Dwrite_f",error, total_error)
@@ -1128,6 +1120,11 @@ END SUBROUTINE test_array_compound_atomic
f_ptr = C_LOC(dset_data_r15(1))
CALL h5dwrite_f(dset_idr8, h5kind_to_type(real_kind_15,H5_REAL_KIND), f_ptr, error)
CALL check("H5Dwrite_f",error, total_error)
+!#ifdef
+ f_ptr = C_LOC(dset_data_r31(1))
+ CALL h5dwrite_f(dset_idr16, h5kind_to_type(real_kind_31,H5_REAL_KIND), f_ptr, error)
+ CALL check("H5Dwrite_f",error, total_error)
+!#endif
!
! Close the file
!
@@ -1155,6 +1152,11 @@ END SUBROUTINE test_array_compound_atomic
f_ptr = C_LOC(data_out_i16)
CALL h5dread_f(dset_id16, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
+!#ifdef
+ f_ptr = C_LOC(data_out_i32)
+ CALL h5dread_f(dset_id32, h5kind_to_type(int_kind_32,H5_INTEGER_KIND), f_ptr, error)
+ CALL check("h5dread_f",error, total_error)
+!#endif
f_ptr = C_LOC(data_out_r)
CALL h5dread_f(dset_idr, H5T_NATIVE_REAL, f_ptr, error)
CALL check("h5dread_f",error, total_error)
@@ -1164,17 +1166,25 @@ END SUBROUTINE test_array_compound_atomic
f_ptr = C_LOC(data_out_r15)
CALL h5dread_f(dset_idr8, h5kind_to_type(real_kind_15,H5_REAL_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
-
+!#ifdef
+ f_ptr = C_LOC(data_out_r31)
+ CALL h5dread_f(dset_idr16, h5kind_to_type(real_kind_31,H5_REAL_KIND), f_ptr, error)
+ CALL check("h5dread_f",error, total_error)
+!#endif
DO i = 1, 4
- CALL verify_Fortran_INTEGER_4("h5kind_to_type1",INT(dset_data_i1(i),int_kind_8),INT(data_out_i1(i),int_kind_8),total_error)
- CALL verify_Fortran_INTEGER_4("h5kind_to_type2",INT(dset_data_i4(i),int_kind_8),INT(data_out_i4(i),int_kind_8),total_error)
- CALL verify_Fortran_INTEGER_4("h5kind_to_type3",INT(dset_data_i8(i),int_kind_8),INT(data_out_i8(i),int_kind_8),total_error)
- CALL verify_Fortran_INTEGER_4("h5kind_to_type4",INT(dset_data_i16(i),int_kind_8),INT(data_out_i16(i),int_kind_8),total_error)
+ CALL verify("h5kind_to_type1",dset_data_i1(i),data_out_i1(i),total_error)
+ CALL verify("h5kind_to_type2",dset_data_i4(i),data_out_i4(i),total_error)
+!!$ CALL verify_Fortran_INTEGER_4("h5kind_to_type3",INT(dset_data_i8(i),int_kind_8),INT(data_out_i8(i),int_kind_8),total_error)
+!!$ CALL verify_Fortran_INTEGER_4("h5kind_to_type4",INT(dset_data_i16(i),int_kind_8),INT(data_out_i16(i),int_kind_8),total_error)
- CALL verify_real_kind_7("h5kind_to_type5",REAL(dset_data_r(i),real_kind_7),REAL(data_out_r(i),real_kind_7),total_error)
- CALL verify_real_kind_7("h5kind_to_type6",REAL(dset_data_r7(i),real_kind_7),REAL(data_out_r7(i),real_kind_7),total_error)
- CALL verify_real_kind_7("h5kind_to_type7",REAL(dset_data_r15(i),real_kind_7),REAL(data_out_r15(i),real_kind_7),total_error)
+!#ifdef
+! PRINT*,dset_data_i16(i),data_out_i16(i)
+!!$ CALL verify_Fortran_INTEGER_4("h5kind_to_type4",INT(dset_data_i16(i),int_kind_8),INT(data_out_i16(i),int_kind_8),total_error)
+!#endif
+ CALL verify("h5kind_to_type5",dset_data_r(i),data_out_r(i),total_error)
+ CALL verify("h5kind_to_type6",dset_data_r7(i),data_out_r7(i),total_error)
+ CALL verify("h5kind_to_type7",dset_data_r15(i),data_out_r15(i),total_error)
END DO
@@ -1212,10 +1222,6 @@ END SUBROUTINE test_h5kind_to_type
!************************************************************
SUBROUTINE t_array(total_error)
- USE ISO_C_BINDING
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1355,10 +1361,6 @@ END SUBROUTINE t_array
SUBROUTINE t_enum(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1419,7 +1421,8 @@ SUBROUTINE t_enum(total_error)
! Insert enumerated value for memtype.
!
val(1) = i
- CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), C_LOC(val(1)), error)
+ f_ptr = C_LOC(val(1))
+ CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), f_ptr, error)
CALL check("H5Tenum_insert_f", error, total_error)
!
! Insert enumerated value for filetype. We must first convert
@@ -1501,7 +1504,7 @@ SUBROUTINE t_enum(total_error)
CALL h5tenum_nameof_f( memtype, rdata(i,j), NAME_BUF_SIZE, name, error)
CALL check("h5tenum_nameof_f",error, total_error)
idx = MOD( (j-1)*(i-1), PLASMA+1 ) + 1
- CALL verifystring("h5tenum_nameof_f",TRIM(name),TRIM(names(idx)), total_error)
+ CALL verify("h5tenum_nameof_f",TRIM(name),TRIM(names(idx)), total_error)
IF(total_error.NE.0) EXIT i_loop
ENDDO
ENDDO i_loop
@@ -1522,10 +1525,6 @@ END SUBROUTINE t_enum
SUBROUTINE t_bit(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1648,10 +1647,6 @@ END SUBROUTINE t_bit
SUBROUTINE t_opaque(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1746,19 +1741,19 @@ SUBROUTINE t_opaque(total_error)
CALL h5tget_tag_f(dtype, tag_sm, taglen, error)
CALL check("h5tget_tag_f",error, total_error)
CALL VERIFY("h5tget_tag_f", taglen, 15, total_error)
- CALL verifystring("h5tget_tag_f",tag_sm,"Character arra", total_error)
+ CALL verify("h5tget_tag_f",tag_sm,"Character arra", total_error)
! Test reading into a string that is exact
CALL h5tget_tag_f(dtype, tag_exact, taglen, error)
CALL check("h5tget_tag_f",error, total_error)
CALL VERIFY("h5tget_tag_f", taglen, 15, total_error)
- CALL verifystring("h5tget_tag_f",tag_exact,"Character array", total_error)
+ CALL verify("h5tget_tag_f",tag_exact,"Character array", total_error)
! Test reading into a string that is to big
CALL h5tget_tag_f(dtype, tag_big, taglen, error)
CALL check("h5tget_tag_f",error, total_error)
CALL VERIFY("h5tget_tag_f", taglen, 15, total_error)
- CALL verifystring("h5tget_tag_f",tag_big,"Character array ", total_error)
+ CALL verify("h5tget_tag_f",tag_big,"Character array ", total_error)
!
! Get dataspace and allocate memory for read buffer.
@@ -1777,7 +1772,7 @@ SUBROUTINE t_opaque(total_error)
CALL check("H5Dread_f",error, total_error)
!
DO i = 1, dims(1)
- CALL verifystring("t_opaque",TRIM(rdata(i)),TRIM(wdata(i)), total_error)
+ CALL verify("t_opaque",TRIM(rdata(i)),TRIM(wdata(i)), total_error)
ENDDO
!
! Close and release resources.
@@ -1796,10 +1791,6 @@ END SUBROUTINE t_opaque
SUBROUTINE t_objref(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1923,9 +1914,9 @@ SUBROUTINE t_objref(total_error)
! Print the object type and close the object.
!
IF(objtype.EQ.H5G_GROUP_F)THEN
- CALL verifystring("t_objref", name(1:name_size),"/G1", total_error)
+ CALL verify("t_objref", name(1:name_size),"/G1", total_error)
ELSE IF(objtype.EQ.H5G_DATASET_F)THEN
- CALL verifystring("t_objref", name(1:name_size),"/DS2", total_error)
+ CALL verify("t_objref", name(1:name_size),"/DS2", total_error)
ELSE
total_error = total_error + 1
ENDIF
@@ -1949,10 +1940,6 @@ END SUBROUTINE t_objref
SUBROUTINE t_regref(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -2108,7 +2095,7 @@ SUBROUTINE t_regref(total_error)
CALL H5Iget_name_f(dset2, name, 80_size_t, size, error)
CALL check("H5Iget_name_f",error, total_error)
CALL VERIFY("H5Iget_name_f", INT(size), LEN_TRIM(name), total_error)
- CALL verifystring("H5Iget_name_f",name(1:size),TRIM(name), total_error)
+ CALL verify("H5Iget_name_f",name(1:size),TRIM(name), total_error)
!
! Allocate space for the read buffer.
!
@@ -2126,7 +2113,7 @@ SUBROUTINE t_regref(total_error)
f_ptr = C_LOC(rdata2(1)(1:1))
CALL h5dread_f( dset2, H5T_NATIVE_INTEGER_1, f_ptr, error, memspace, space)
CALL check("H5Dread_f",error, total_error)
- CALL verifystring("h5dread_f",rdata2(1)(1:npoints),TRIM(chrref_correct(i)), total_error)
+ CALL verify("h5dread_f",rdata2(1)(1:npoints),TRIM(chrref_correct(i)), total_error)
CALL H5Sclose_f(space, error)
CALL check("h5sclose_f",error, total_error)
@@ -2149,10 +2136,6 @@ END SUBROUTINE t_regref
SUBROUTINE t_vlen(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -2307,10 +2290,6 @@ END SUBROUTINE t_vlen
SUBROUTINE t_vlstring(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -2409,7 +2388,7 @@ SUBROUTINE t_vlstring(total_error)
! Output the data to the screen.
!
DO i = 1, dims(1)
- CALL verifystring("h5dopen_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
+ CALL verify("h5dopen_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
END DO
DEALLOCATE(rdata)
@@ -2428,10 +2407,6 @@ SUBROUTINE t_vlstring_readwrite(total_error)
! test writing and reading vl string using h5dread_f and h5dwrite_f, C_LOC and C_F_POINTER
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -2611,7 +2586,7 @@ SUBROUTINE t_vlstring_readwrite(total_error)
IF(DATA(len+1:len+1).EQ.C_NULL_CHAR.OR.len.GE.8) EXIT
len = len + 1
ENDDO
- CALL verifystring("h5dread_f",data(1:len), data_w(i)(1:len), total_error)
+ CALL verify("h5dread_f",data(1:len), data_w(i)(1:len), total_error)
END DO
DEALLOCATE(rdata)
@@ -2659,7 +2634,7 @@ SUBROUTINE t_vlstring_readwrite(total_error)
IF(DATA(len+1:len+1).EQ.C_NULL_CHAR.OR.len.GE.8) EXIT
len = len + 1
ENDDO
- CALL verifystring("h5dread_f",DATA(1:len), data2D_w(i,j)(1:len), total_error)
+ CALL verify("h5dread_f",DATA(1:len), data2D_w(i,j)(1:len), total_error)
ENDDO
END DO
@@ -2679,10 +2654,6 @@ END SUBROUTINE t_vlstring_readwrite
SUBROUTINE t_string(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -2784,7 +2755,7 @@ SUBROUTINE t_string(total_error)
CALL check("H5Dread_f",error, total_error)
DO i = 1, dims(1)
- CALL verifystring("h5dread_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
+ CALL verify("h5dread_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
END DO
DEALLOCATE(rdata)
@@ -2806,8 +2777,6 @@ END SUBROUTINE t_string
SUBROUTINE vl_test_special_char(total_error)
- USE HDF5
- USE TH5_MISC
IMPLICIT NONE
! INTERFACE
@@ -2909,9 +2878,6 @@ END SUBROUTINE vl_test_special_char
SUBROUTINE setup_buffer(data_in, line_lengths, char_type)
- USE HDF5
- USE ISO_C_BINDING
-
IMPLICIT NONE
! Creates a simple "Data_in" consisting of the letters of the alphabet,
@@ -2973,10 +2939,6 @@ END SUBROUTINE setup_buffer
SUBROUTINE test_nbit(total_error )
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(Fortran_REAL_C_FLOAT) !should map to REAL*4 on most modern processors
INTEGER, INTENT(INOUT) :: total_error
@@ -3068,8 +3030,10 @@ SUBROUTINE test_nbit(total_error )
!
i_loop: DO i = 1, dims(1)
j_loop: DO j = 1, dims(2)
+
IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE ! skip IF value is NaN
- IF( .NOT.dreal_eq( REAL(new_data(i,j),dp), REAL( orig_data(i,j), dp)) ) THEN
+
+ IF( .NOT.check_real_eq( new_data(i,j), orig_data(i,j)) ) THEN
total_error = total_error + 1
WRITE(*,'(" Read different values than written.")')
WRITE(*,'(" At index ", 2(1X,I0))') i, j
@@ -3117,9 +3081,6 @@ SUBROUTINE t_enum_conv(total_error)
! No reliance on C tests.
!-------------------------------------------------------------------------
!
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
IMPLICIT NONE
@@ -3188,20 +3149,25 @@ SUBROUTINE t_enum_conv(total_error)
!
! Initialize enum data.
!
+
val = E1_RED
CALL H5Tenum_insert_f(dtype, "RED", C_LOC(val), error)
CALL check("h5tenum_insert_f",error, total_error)
val = E1_GREEN
- CALL H5Tenum_insert_f(dtype, "GREEN", C_LOC(val), error)
+ f_ptr = C_LOC(val)
+ CALL H5Tenum_insert_f(dtype, "GREEN", f_ptr, error)
CALL check("h5tenum_insert_f",error, total_error)
val = E1_BLUE
- CALL H5Tenum_insert_f(dtype, "BLUE", C_LOC(val), error)
+ f_ptr = C_LOC(val)
+ CALL H5Tenum_insert_f(dtype, "BLUE", f_ptr, error)
CALL check("h5tenum_insert_f",error, total_error)
val = E1_WHITE
- CALL H5Tenum_insert_f(dtype, "WHITE", C_LOC(val), error)
+ f_ptr = C_LOC(val)
+ CALL H5Tenum_insert_f(dtype, "WHITE", f_ptr, error)
CALL check("h5tenum_insert_f",error, total_error)
val = E1_BLACK
- CALL H5Tenum_insert_f(dtype, "BLACK", C_LOC(val), error)
+ f_ptr = C_LOC(val)
+ CALL H5Tenum_insert_f(dtype, "BLACK", f_ptr, error)
CALL check("h5tenum_insert_f",error, total_error)
!
! Create dataspace. Setting maximum size to be the current size.
diff --git a/fortran/test/tH5VL.f90 b/fortran/test/tH5VL.f90
index 651ca75..834fbde 100644
--- a/fortran/test/tH5VL.f90
+++ b/fortran/test/tH5VL.f90
@@ -28,12 +28,13 @@
!*****
MODULE TH5VL
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
CONTAINS
SUBROUTINE vl_test_integer(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -194,8 +195,6 @@ CONTAINS
END SUBROUTINE vl_test_integer
SUBROUTINE vl_test_real(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -328,18 +327,15 @@ CONTAINS
CALL h5dread_vl_f(dset_id, vltype_id, vl_real_data_out, data_dims, len_out, &
error, mem_space_id = dspace_id, file_space_id = dspace_id)
CALL check("h5dread_real_f", error, total_error)
- do ih = 1, data_dims(2)
- do jh = 1, len_out(ih)
- IF( .NOT.dreal_eq( REAL(vl_real_data(jh,ih),dp), REAL(vl_real_data_out(jh,ih), dp)) ) THEN
- total_error = total_error + 1
- WRITE(*,*) "h5dread_vl_f returned incorrect data"
- ENDIF
- enddo
- if (len(ih) .ne. len_out(ih)) then
- total_error = total_error + 1
- write(*,*) "h5dread_vl_f returned incorrect data"
- endif
- enddo
+ DO ih = 1, data_dims(2)
+ DO jh = 1, len_out(ih)
+ CALL VERIFY("h5dread_vl_f returned incorrect data",vl_real_data(jh,ih),vl_real_data_out(jh,ih), total_error)
+ ENDDO
+ IF (LEN(ih) .NE. len_out(ih)) THEN
+ total_error = total_error + 1
+ WRITE(*,*) "h5dread_vl_f returned incorrect data"
+ ENDIF
+ ENDDO
!
@@ -367,8 +363,6 @@ CONTAINS
END SUBROUTINE vl_test_real
SUBROUTINE vl_test_string(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
diff --git a/fortran/test/tHDF5.f90 b/fortran/test/tHDF5.f90
index e73fed2..d12bb25 100644
--- a/fortran/test/tHDF5.f90
+++ b/fortran/test/tHDF5.f90
@@ -29,6 +29,7 @@
MODULE THDF5
USE TH5_MISC
+ USE TH5_MISC_GEN
USE TH5A
USE TH5D
USE TH5E
diff --git a/fortran/test/tf.F90 b/fortran/test/tf.F90
index 505d945..7d67f30 100644
--- a/fortran/test/tf.F90
+++ b/fortran/test/tf.F90
@@ -59,36 +59,6 @@ CONTAINS
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: dreal_eq
-!DEC$endif
- LOGICAL FUNCTION dreal_eq(a,b)
-
- ! Check if two double precision reals are equivalent
- REAL(dp), INTENT (in):: a,b
- REAL(dp), PARAMETER :: eps = 1.e-8
- dreal_eq = ABS(a-b) .LT. eps
-
- END FUNCTION dreal_eq
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: verify_real_kind_7
-!DEC$endif
- SUBROUTINE verify_real_kind_7(string,value,correct_value,total_error)
- USE HDF5
- INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_C_FLOAT) !should map to REAL*4 on most modern processors
- CHARACTER(LEN=*) :: string
- REAL(real_kind_7) :: value, correct_value
- INTEGER :: total_error
- IF (.NOT.dreal_eq( REAL(value,dp), REAL(correct_value, dp)) ) THEN
- total_error=total_error+1
- WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string
- ENDIF
- RETURN
- END SUBROUTINE verify_real_kind_7
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
!DEC$attributes dllexport :: write_test_status
!DEC$endif
SUBROUTINE write_test_status( test_result, test_title, total_error)
@@ -140,84 +110,6 @@ CONTAINS
RETURN
END SUBROUTINE check
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: verify
-!DEC$endif
- SUBROUTINE VERIFY(string,value,correct_value,total_error)
- CHARACTER(LEN=*) :: string
- INTEGER :: value, correct_value, total_error
- IF (value .NE. correct_value) THEN
- total_error=total_error+1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
- END SUBROUTINE verify
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: verify_INTEGER_HID_T
-!DEC$endif
- SUBROUTINE verify_INTEGER_HID_T(string,value,correct_value,total_error)
- USE HDF5
- CHARACTER(LEN=*) :: string
- INTEGER(HID_T) :: value, correct_value
- INTEGER :: total_error
- IF (value .NE. correct_value) THEN
- total_error=total_error+1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
- END SUBROUTINE verify_INTEGER_HID_T
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: verify_Fortran_INTEGER_4
-!DEC$endif
- SUBROUTINE verify_Fortran_INTEGER_4(string,value,correct_value,total_error)
- USE HDF5
- INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) ! should map to INTEGER*4 on most modern processors
- CHARACTER(LEN=*) :: string
- INTEGER(int_kind_8) :: value, correct_value
- INTEGER :: total_error
- IF (value .NE. correct_value) THEN
- total_error=total_error+1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
- END SUBROUTINE verify_Fortran_INTEGER_4
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: verifyLogical
-!DEC$endif
- SUBROUTINE verifyLogical(string,value,correct_value,total_error)
- CHARACTER(LEN=*) :: string
- LOGICAL :: value, correct_value
- INTEGER :: total_error
- IF (value .NEQV. correct_value) THEN
- total_error = total_error + 1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
- END SUBROUTINE verifyLogical
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: verifyString
-!DEC$endif
- SUBROUTINE verifyString(string, value,correct_value,total_error)
- CHARACTER*(*) :: string
- CHARACTER*(*) :: value, correct_value
- INTEGER :: total_error
- IF (TRIM(value) .NE. TRIM(correct_value)) THEN
- total_error = total_error + 1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
- END SUBROUTINE verifyString
-
-
!----------------------------------------------------------------------
! Name: h5_fixname_f
!
diff --git a/m4/aclocal_fc.m4 b/m4/aclocal_fc.m4
index d2eef67..5107cc1 100644
--- a/m4/aclocal_fc.m4
+++ b/m4/aclocal_fc.m4
@@ -63,6 +63,20 @@ dnl was required" problem when libtool is also used
dnl [1] MPICH.org
dnl
+dnl See if the fortran compiler supports the intrinsic module "ISO_FORTRAN_ENV"
+
+AC_DEFUN([PAC_PROG_FC_ISO_FORTRAN_ENV],[
+ HAVE_ISO_FORTRAN_ENV="no"
+ AC_MSG_CHECKING([if Fortran compiler supports intrinsic module ISO_FORTRAN_ENV])
+ AC_LINK_IFELSE([AC_LANG_SOURCE([
+ PROGRAM main
+ USE, INTRINSIC :: ISO_FORTRAN_ENV
+ END PROGRAM
+ ])],[AC_MSG_RESULT([yes])
+ HAVE_ISO_FORTRAN_ENV="yes"],
+ [AC_MSG_RESULT([no])])
+])
+
dnl See if the fortran compiler supports the intrinsic function "SIZEOF"
AC_DEFUN([PAC_PROG_FC_SIZEOF],[