summaryrefslogtreecommitdiffstats
path: root/fortran/test
diff options
context:
space:
mode:
Diffstat (limited to 'fortran/test')
-rw-r--r--fortran/test/fflush1.f902
-rw-r--r--fortran/test/fflush2.f902
-rw-r--r--fortran/test/t.c38
-rw-r--r--fortran/test/t.h10
-rw-r--r--fortran/test/tH5I.f905
-rw-r--r--fortran/test/tH5R.f904
-rw-r--r--fortran/test/tH5Sselect.f906
-rw-r--r--fortran/test/tH5T.f902
-rw-r--r--fortran/test/tH5Z.f9036
-rw-r--r--fortran/test/tf.f9052
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
+
generated by cgit v0.12 at 2024-07-18 07:46:38 (GMT)