diff options
Diffstat (limited to 'fortran/test')
-rw-r--r-- | fortran/test/fflush1.f90 | 2 | ||||
-rw-r--r-- | fortran/test/fflush2.f90 | 2 | ||||
-rw-r--r-- | fortran/test/t.c | 38 | ||||
-rw-r--r-- | fortran/test/t.h | 10 | ||||
-rw-r--r-- | fortran/test/tH5I.f90 | 5 | ||||
-rw-r--r-- | fortran/test/tH5R.f90 | 4 | ||||
-rw-r--r-- | fortran/test/tH5Sselect.f90 | 6 | ||||
-rw-r--r-- | fortran/test/tH5T.f90 | 2 | ||||
-rw-r--r-- | fortran/test/tH5Z.f90 | 36 | ||||
-rw-r--r-- | fortran/test/tf.f90 | 52 |
10 files changed, 114 insertions, 43 deletions
diff --git a/fortran/test/fflush1.f90 b/fortran/test/fflush1.f90 index 6c1cad8..52efb21 100644 --- a/fortran/test/fflush1.f90 +++ b/fortran/test/fflush1.f90 @@ -145,7 +145,7 @@ ! if errors detected, exit with non-zero code. This is not truly fortran ! standard but likely supported by most fortran compilers. - IF (total_error .ne. 0) CALL exit (total_error) + IF (total_error .ne. 0) CALL h5_exit_f (total_error) 001 STOP diff --git a/fortran/test/fflush2.f90 b/fortran/test/fflush2.f90 index acfe320..313a2a5 100644 --- a/fortran/test/fflush2.f90 +++ b/fortran/test/fflush2.f90 @@ -178,6 +178,6 @@ ! if errors detected, exit with non-zero code. This is not truly fortran ! standard but likely supported by most fortran compilers. - IF (total_error .ne. 0) CALL exit (total_error) + IF (total_error .ne. 0) CALL h5_exit_f (total_error) END PROGRAM FFLUSH2EXAMPLE diff --git a/fortran/test/t.c b/fortran/test/t.c index 3109523..0299869 100644 --- a/fortran/test/t.c +++ b/fortran/test/t.c @@ -28,11 +28,10 @@ * Modifications: *---------------------------------------------------------------------------*/ int_f -nh5_fixname_c(_fcd base_name, int_f *base_namelen, hid_t_f* fapl, _fcd full_name, int_f *full_namelen) +nh5_fixname_c(_fcd base_name, size_t_f *base_namelen, hid_t_f* fapl, _fcd full_name, size_t_f *full_namelen) { int ret_value = -1; char *c_base_name; - int c_base_namelen; char *c_full_name; hid_t c_fapl; @@ -43,8 +42,7 @@ nh5_fixname_c(_fcd base_name, int_f *base_namelen, hid_t_f* fapl, _fcd full_name /* * Convert FORTRAN name to C name */ - c_base_namelen = *base_namelen; - c_base_name = (char *)HD5f2cstring(base_name, c_base_namelen); + c_base_name = (char *)HD5f2cstring(base_name, (size_t)*base_namelen); if (c_base_name == NULL) goto DONE; c_full_name = (char *) HDmalloc((size_t)*full_namelen + 1); if (c_full_name == NULL) goto DONE; @@ -53,10 +51,11 @@ nh5_fixname_c(_fcd base_name, int_f *base_namelen, hid_t_f* fapl, _fcd full_name * Call h5_fixname function. */ if (NULL != h5_fixname(c_base_name, c_fapl, c_full_name, (size_t)*full_namelen + 1)) { - HD5packFstring(c_full_name, _fcdtocp(full_name), *full_namelen); - ret_value = 0; - goto DONE; + HD5packFstring(c_full_name, _fcdtocp(full_name), (size_t)*full_namelen); + ret_value = 0; + goto DONE; } + DONE: if (NULL != c_base_name) HDfree(c_base_name); if (NULL != c_full_name) HDfree(c_full_name); @@ -75,12 +74,11 @@ DONE: * Modifications: *---------------------------------------------------------------------------*/ int_f -nh5_cleanup_c(_fcd base_name, int_f *base_namelen, hid_t_f* fapl) +nh5_cleanup_c(_fcd base_name, size_t_f *base_namelen, hid_t_f* fapl) { char filename[1024]; int ret_value = -1; char *c_base_name[1]; - int c_base_namelen; hid_t c_fapl; /* @@ -91,8 +89,7 @@ nh5_cleanup_c(_fcd base_name, int_f *base_namelen, hid_t_f* fapl) /* * Convert FORTRAN name to C name */ - c_base_namelen = *base_namelen; - c_base_name[0] = (char *)HD5f2cstring(base_name, c_base_namelen); + c_base_name[0] = (char *)HD5f2cstring(base_name, (size_t)*base_namelen); if (c_base_name[0] == NULL) goto DONE; /* @@ -104,10 +101,27 @@ nh5_cleanup_c(_fcd base_name, int_f *base_namelen, hid_t_f* fapl) } */ h5_fixname(c_base_name[0], c_fapl, filename, sizeof(filename)); - remove(filename); + HDremove(filename); ret_value =0; + DONE: if (NULL != c_base_name[0]) HDfree(c_base_name[0]); return ret_value; } + +/*---------------------------------------------------------------------------- + * Name: h5_exit_c + * Purpose: Call 'exit()' to terminate application + * Inputs: status - status for exit() to return + * Returns: none + * Programmer: Quincey Koziol + * Tuesday, December 14, 2004 + * Modifications: + *---------------------------------------------------------------------------*/ +void +nh5_exit_c(int_f *status) +{ + HDexit((int)*status); +} /* h5_exit_c */ + diff --git a/fortran/test/t.h b/fortran/test/t.h index fca9cb1..0286028 100644 --- a/fortran/test/t.h +++ b/fortran/test/t.h @@ -24,13 +24,19 @@ char *h5_fixname(const char *base_name, hid_t fapl, char *fullname, size_t size) #ifdef DF_CAPFNAMES # define nh5_fixname_c FNAME(H5_FIXNAME_C) # define nh5_cleanup_c FNAME(H5_CLEANUP_C) +# define nh5_exit_c FNAME(H5_EXIT_C) #else /* !DF_CAPFNAMES */ # define nh5_fixname_c FNAME(h5_fixname_c) # define nh5_cleanup_c FNAME(h5_cleanup_c) +# define nh5_exit_c FNAME(h5_exit_c) #endif /* DF_CAPFNAMES */ H5_FCTESTDLL int_f nh5_fixname_c -(_fcd base_name, int_f *base_namelen, hid_t_f *fapl, _fcd full_name, int_f *full_namelen); +(_fcd base_name, size_t_f *base_namelen, hid_t_f *fapl, _fcd full_name, size_t_f *full_namelen); H5_FCTESTDLL int_f nh5_cleanup_c -(_fcd base_name, int_f *base_namelen, hid_t_f *fapl); +(_fcd base_name, size_t_f *base_namelen, hid_t_f *fapl); + +H5_FCTESTDLL void nh5_exit_c +(int_f *status); + diff --git a/fortran/test/tH5I.f90 b/fortran/test/tH5I.f90 index fb526e4..8790bc3 100644 --- a/fortran/test/tH5I.f90 +++ b/fortran/test/tH5I.f90 @@ -31,7 +31,7 @@ INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: new_file_id ! File identifier + INTEGER(HID_T) :: new_file_id ! File identifier INTEGER(HID_T) :: group_id ! group identifier INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dspace_id ! Dataspace identifier @@ -103,12 +103,13 @@ total_error = total_error + 1 endif endif + ! ! Get file identifier from dataset identifier and then get file name ! CALL h5iget_file_id_f(dset_id, new_file_id, error) CALL check("h5iget_file_id_f",error,total_error) - name_size = 80 + name_size = 280 CALL h5fget_name_f(new_file_id, name_buf1, name_size, error) CALL check("h5fget_name_f",error,total_error) if (name_buf1(1:name_size) .ne. fix_filename(1:name_size)) then diff --git a/fortran/test/tH5R.f90 b/fortran/test/tH5R.f90 index 7cc71a5..d4f2911 100644 --- a/fortran/test/tH5R.f90 +++ b/fortran/test/tH5R.f90 @@ -223,13 +223,13 @@ INTEGER(HSIZE_T), DIMENSION(2) :: data_dims INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/2,9/) ! Datasets dimensions INTEGER(HSIZE_T), DIMENSION(1) :: dimsr = (/2/) ! - INTEGER(HSSIZE_T), DIMENSION(2) :: start + INTEGER(HSIZE_T), DIMENSION(2) :: start INTEGER(HSIZE_T), DIMENSION(2) :: count INTEGER :: rankr = 1 INTEGER :: rank = 2 INTEGER , DIMENSION(2,9) :: data INTEGER , DIMENSION(2,9) :: data_out = 0 - INTEGER(HSSIZE_T) , DIMENSION(2,3) :: coord + INTEGER(HSIZE_T) , DIMENSION(2,3) :: coord INTEGER(SIZE_T) ::num_points = 3 ! Number of selected points INTEGER :: i, j coord = reshape((/1,1,2,7,1,9/), (/2,3/)) ! Coordinates of selected points diff --git a/fortran/test/tH5Sselect.f90 b/fortran/test/tH5Sselect.f90 index ad95ecf..690e957 100644 --- a/fortran/test/tH5Sselect.f90 +++ b/fortran/test/tH5Sselect.f90 @@ -371,7 +371,7 @@ ! !Points positions in the file ! - INTEGER(HSSIZE_T), DIMENSION(RANK,NUMP) :: coord + INTEGER(HSIZE_T), DIMENSION(RANK,NUMP) :: coord ! !data buffers @@ -760,7 +760,7 @@ ! !array to give selected points' coordinations ! - INTEGER(HSSIZE_T), DIMENSION(RANK, NUMPS) :: coord + INTEGER(HSIZE_T), DIMENSION(RANK, NUMPS) :: coord ! !Size of the hyperslab in memory @@ -793,7 +793,7 @@ ! !start and end bounds in the current dataspace selection ! - INTEGER(HSSIZE_T), DIMENSION(RANK) :: startout, endout + INTEGER(HSIZE_T), DIMENSION(RANK) :: startout, endout ! !data to write diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 index 5e406b8..f2dddb4 100644 --- a/fortran/test/tH5T.f90 +++ b/fortran/test/tH5T.f90 @@ -85,7 +85,7 @@ INTEGER :: array_dims_range = 3 INTEGER :: elements = 24 ! number of elements in the array_dims array. INTEGER(SIZE_T) :: sizechar - INTEGER(HSIZE_T), DIMENSION(2) :: data_dims + INTEGER(HSIZE_T), DIMENSION(1) :: data_dims LOGICAL :: flag = .TRUE. data_dims(1) = dimsize ! diff --git a/fortran/test/tH5Z.f90 b/fortran/test/tH5Z.f90 index 4260fca..c64d99b 100644 --- a/fortran/test/tH5Z.f90 +++ b/fortran/test/tH5Z.f90 @@ -145,7 +145,6 @@ endif endif - RETURN END SUBROUTINE filters_test @@ -181,7 +180,6 @@ INTEGER :: num_errors = 0 ! Number of data errors INTEGER :: i, j !general purpose integers - INTEGER :: config_flags ! for h5zget_filter_info_f INTEGER(HSIZE_T), DIMENSION(2) :: data_dims INTEGER(HID_T) :: crp_list INTEGER :: options_mask, pix_per_block @@ -191,26 +189,36 @@ INTEGER :: filter_flag = -1 INTEGER(SIZE_T) :: cd_nelemnts = 4 INTEGER(SIZE_T) :: filter_name_len = 4 - INTEGER, DIMENSION(4) :: cd_values + INTEGER, DIMENSION(4) :: cd_values + INTEGER :: config_flag = 0 ! for h5zget_filter_info_f ! ! Verify that SZIP exists and has an encoder ! - CALL h5zfilter_avail_f(H5Z_FILTER_SZIP_F, flag, error) - CALL check("h5zfilter_avail_f", error, total_error) - if(.NOT. flag) then + CALL h5zget_filter_info_f(H5Z_FILTER_SZIP_F, config_flag, error) + CALL check("h5zget_filter_info", error, total_error) + if ( IAND(config_flag, H5Z_FILTER_ENCODE_ENABLED_F) .EQ. 0 ) then szip_flag = .FALSE. total_error = -1 return endif + CALL h5zfilter_avail_f(H5Z_FILTER_SZIP_F, flag, error) + CALL check("h5zfilter_avail", error, total_error) - CALL h5zget_filter_info_f(H5Z_FILTER_SZIP_F, config_flags, error) - CALL check("h5zget_filter_info_f", error, total_error) - if(.NOT. (IAND(config_flags, H5Z_FILTER_ENCODE_ENABLED_F) .eq. 1) ) then - szip_flag = .FALSE. - total_error = -1 - return - endif + ! + ! Make sure h5zget_filter_info_f returns the right flag + ! + if( flag ) then + if ( config_flag .NE. IOR( H5Z_FILTER_ENCODE_ENABLED_F, H5Z_FILTER_DECODE_ENABLED_F) ) then + error = -1 + CALL check("h5zget_filter_info config_flag", error, total_error) + endif + else + if ( config_flag .NE. 0 ) then + error = -1 + CALL check("h5zget_filter_info config_flag", error, total_error) + endif + endif options_mask = H5_SZIP_NN_OM_F pix_per_block = 32 @@ -255,6 +263,8 @@ CALL h5pclose_f(crp_list, error) CALL h5sclose_f(dspace_id, error) CALL h5fclose_f(file_id, error) + szip_flag = .FALSE. + total_error = -1 return endif diff --git a/fortran/test/tf.f90 b/fortran/test/tf.f90 index 3a72571..057d47c 100644 --- a/fortran/test/tf.f90 +++ b/fortran/test/tf.f90 @@ -80,8 +80,8 @@ INTEGER, INTENT(OUT) :: hdferr ! Error code INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list - INTEGER :: base_namelen ! Length of the base name character string - INTEGER :: full_namelen ! Length of the full name character string + INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string + INTEGER(SIZE_T) :: full_namelen ! Length of the full name character string ! INTEGER(HID_T) :: fapl_default INTERFACE @@ -94,10 +94,10 @@ !DEC$ATTRIBUTES reference :: base_name !DEC$ATTRIBUTES reference :: full_name CHARACTER(LEN=*), INTENT(IN) :: base_name - INTEGER :: base_namelen + INTEGER(SIZE_T) :: base_namelen INTEGER(HID_T), INTENT(IN) :: fapl CHARACTER(LEN=*), INTENT(IN) :: full_name - INTEGER :: full_namelen + INTEGER(SIZE_T) :: full_namelen END FUNCTION h5_fixname_c END INTERFACE @@ -139,7 +139,7 @@ INTEGER, INTENT(OUT) :: hdferr ! Error code INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list - INTEGER :: base_namelen ! Length of the base name character string + INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string INTERFACE INTEGER FUNCTION h5_cleanup_c(base_name, base_namelen, fapl) @@ -149,7 +149,7 @@ !DEC$ ENDIF !DEC$ATTRIBUTES reference :: base_name CHARACTER(LEN=*), INTENT(IN) :: base_name - INTEGER :: base_namelen + INTEGER(SIZE_T) :: base_namelen INTEGER(HID_T), INTENT(IN) :: fapl END FUNCTION h5_cleanup_c END INTERFACE @@ -158,3 +158,43 @@ hdferr = h5_cleanup_c(base_name, base_namelen, fapl) END SUBROUTINE h5_cleanup_f + +!---------------------------------------------------------------------- +! Name: h5_exit_f +! +! Purpose: Exit application +! It is a fortran counterpart for the standard C 'exit()' routine +! +! Inputs: +! status - Status to return from application +! +! Outputs: +! none +! +! Programmer: Quincey Koziol +! December 14, 2004 +! +! +!---------------------------------------------------------------------- + SUBROUTINE h5_exit_f(status) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5_exit_f +!DEC$endif + IMPLICIT NONE + INTEGER, INTENT(IN) :: status ! Return code + + INTERFACE + SUBROUTINE h5_exit_c(status) + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !MS$ATTRIBUTES C,reference,alias:'_H5_EXIT_C':: h5_exit_c + !DEC$ ENDIF + INTEGER, INTENT(IN) :: status + END SUBROUTINE h5_exit_c + END INTERFACE + + CALL h5_exit_c(status) + + END SUBROUTINE h5_exit_f + |