summaryrefslogtreecommitdiffstats
path: root/fortran/test
diff options
context:
space:
mode:
authorQuincey Koziol <koziol@hdfgroup.org>2004-12-29 14:26:20 (GMT)
committerQuincey Koziol <koziol@hdfgroup.org>2004-12-29 14:26:20 (GMT)
commit427ff7da2848042f68ecfadf5a321b1d8077e9db (patch)
tree73024b1954031fbb724c2d96a485590348e5cc22 /fortran/test
parent9b96fd2003ae74cca389cc4c2216b4371d6eb173 (diff)
downloadhdf5-427ff7da2848042f68ecfadf5a321b1d8077e9db.zip
hdf5-427ff7da2848042f68ecfadf5a321b1d8077e9db.tar.gz
hdf5-427ff7da2848042f68ecfadf5a321b1d8077e9db.tar.bz2
[svn-r9727] Purpose:
Bug Fix/Code Cleanup/Doc Cleanup/Optimization/Branch Sync :-) Description: Generally speaking, this is the "signed->unsigned" change to selections. However, in the process of merging code back, things got stickier and stickier until I ended up doing a big "sync the two branches up" operation. So... I brought back all the "infrastructure" fixes from the development branch to the release branch (which I think were actually making some improvement in performance) as well as fixed several bugs which had been fixed in one branch, but not the other. I've also tagged the repository before making this checkin with the label "before_signed_unsigned_changes". Platforms tested: FreeBSD 4.10 (sleipnir) w/parallel & fphdf5 FreeBSD 4.10 (sleipnir) w/threadsafe FreeBSD 4.10 (sleipnir) w/backward compatibility Solaris 2.7 (arabica) w/"purify options" Solaris 2.8 (sol) w/FORTRAN & C++ AIX 5.x (copper) w/parallel & FORTRAN IRIX64 6.5 (modi4) w/FORTRAN Linux 2.4 (heping) w/FORTRAN & C++ Misc. update:
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
+