diff options
Diffstat (limited to 'fortran')
| -rw-r--r-- | fortran/test/fortranlib_test.f90 | 10 | ||||
| -rw-r--r-- | fortran/test/tH5T.f90 | 89 |
2 files changed, 99 insertions, 0 deletions
diff --git a/fortran/test/fortranlib_test.f90 b/fortran/test/fortranlib_test.f90 index d90fcba..9b00bab 100644 --- a/fortran/test/fortranlib_test.f90 +++ b/fortran/test/fortranlib_test.f90 @@ -37,6 +37,7 @@ INTEGER :: basic_select_total_error = 0 INTEGER :: total_error_compoundtest = 0 INTEGER :: basic_datatype_total_error = 0 + INTEGER :: enum_total_error = 0 INTEGER :: external_total_error = 0 INTEGER :: attribute_total_error = 0 INTEGER :: identifier_total_error = 0 @@ -206,6 +207,15 @@ write(*, fmt = e_format) error_string total_error = total_error + total_error_compoundtest + error_string = failure + CALL enumtest(cleanup, enum_total_error) + IF (enum_total_error == 0) error_string = success + write(*, fmt = '(19a)', advance = 'no') ' Enum datatype test' + write(*, fmt = '(51x,a)', advance = 'no') ' ' + write(*, fmt = e_format) error_string + total_error = total_error + enum_total_error + + ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing PROPERTY interface ' diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 index d7669af..d2403d9 100644 --- a/fortran/test/tH5T.f90 +++ b/fortran/test/tH5T.f90 @@ -711,3 +711,92 @@ RETURN END SUBROUTINE basic_data_type_test + + SUBROUTINE enumtest(cleanup, total_error) + + USE HDF5 + IMPLICIT none + + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + CHARACTER(LEN=7), PARAMETER :: filename="enum.h5" + CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=8), PARAMETER :: dsetname="enumdset" + CHARACTER(LEN=4) :: true ="TRUE" + CHARACTER(LEN=5) :: false="FALSE" + CHARACTER(LEN=5) :: mem_name + + INTEGER(HID_T) :: file_id + INTEGER(HID_T) :: dset_id + INTEGER(HID_T) :: dspace_id + INTEGER(HID_T) :: dtype_id + INTEGER :: error + INTEGER :: value + INTEGER(HSIZE_T), DIMENSION(1) :: dsize + INTEGER(SIZE_T) :: buf_size + INTEGER, DIMENSION(2) :: data + INTEGER(HSIZE_T), DIMENSION(7) :: dims + + dims(1) = 2 + dsize(1) = 2 + data(1) = 1 + data(2) = 0 + ! + ! Create a new file using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + CALL h5fcreate_f(fix_filename,H5F_ACC_TRUNC_F,file_id,error) + CALL check("h5fcreate_f", error, total_error) + ! + ! Create enumeration datatype with tow values + ! + CALL h5tenum_create_f(H5T_NATIVE_INTEGER,dtype_id,error) + CALL check("h5tenum_create_f", error, total_error) + CALL h5tenum_insert_f(dtype_id,true,data(1),error) + CALL check("h5tenum_insert_f", error, total_error) + CALL h5tenum_insert_f(dtype_id,false,data(2),error) + CALL check("h5tenum_insert_f", error, total_error) + ! + ! Create write and close a dataset with enum datatype + ! + CALL h5screate_simple_f(1,dsize,dspace_id,error) + CALL check("h5screate_simple_f", error, total_error) + CALL h5dcreate_f(file_id,dsetname,dtype_id,dspace_id,dset_id,error) + CALL check("h5dcreate_f", error, total_error) + CALL h5dwrite_f(dset_id,dtype_id,data,dims,error) + CALL check("h5dwrite_f", error, total_error) + CALL h5dclose_f(dset_id,error) + CALL check("h5dclose_f", error, total_error) + CALL h5sclose_f(dspace_id,error) + CALL check("h5sclose_f", error, total_error) + ! + ! Get value of "TRUE" + ! + CALL h5tenum_valueof_f(dtype_id, "TRUE", value, error) + CALL check("h5tenum_valueof_f", error, total_error) + if (value .ne. 1) then + write(*,*) " Value of TRUE is not 1, error" + total_error = total_error + 1 + endif + ! + ! Get name of 0 + ! + value = 0 + buf_size = 5 + CALL h5tenum_nameof_f(dtype_id, value, buf_size, mem_name, error) + CALL check("h5tenum_nameof_f", error, total_error) + if (mem_name .ne. "FALSE") then + write(*,*) " Wrong name for 0 value" + total_error = total_error + 1 + endif + CALL h5tclose_f(dtype_id,error) + CALL check("h5tclose_f", error, total_error) + CALL h5fclose_f(file_id,error) + CALL check("h5fclose_f", error, total_error) + RETURN + END SUBROUTINE enumtest + |