summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2012-07-03 01:12:37 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2012-07-03 01:12:37 (GMT)
commit11861e66189884c860224de577b00a16e0afe0c0 (patch)
treebe17f326a36a39e26ac5572b93398ad60b3355f4 /fortran
parentd05e1c8ca189173070a2fc1c30802ec8be479085 (diff)
downloadhdf5-11861e66189884c860224de577b00a16e0afe0c0.zip
hdf5-11861e66189884c860224de577b00a16e0afe0c0.tar.gz
hdf5-11861e66189884c860224de577b00a16e0afe0c0.tar.bz2
[svn-r22509] Merged changes from the trunk into the branch:
svn merge -r 22163:22479 https://svn.hdfgroup.uiuc.edu/hdf5/trunk/fortran Fixed merged issue with fortran/test/tH5E_F03.f90 (missing part of the file) and changed Makefile.am accordingly.
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Off.f90137
-rw-r--r--fortran/src/H5Tff.f9057
-rw-r--r--fortran/test/Makefile.am6
-rw-r--r--fortran/test/Makefile.in10
-rw-r--r--fortran/test/tH5E_F03.f90176
-rw-r--r--fortran/test/tH5T.f9045
6 files changed, 321 insertions, 110 deletions
diff --git a/fortran/src/H5Off.f90 b/fortran/src/H5Off.f90
index 04c96e2..4f1ea18 100644
--- a/fortran/src/H5Off.f90
+++ b/fortran/src/H5Off.f90
@@ -49,33 +49,32 @@ CONTAINS
!
! PURPOSE
! Creates a hard link to an object in an HDF5 file.
-! INPUTS
+!
+! Inputs:
! object_id - Object to be linked.
! new_loc_id - File or group identifier specifying location at which object is to be linked.
! new_link_name - Name of link to be created, relative to new_loc_id.
-! OUTPUTS
-! hdferr: - error code
-! Success: 0
-! Failure: -1
-! OPTIONAL PARAMETERS
+!
+! Outputs:
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! Optional parameters:
! lcpl_id - Link creation property list identifier.
! lapl_id - Link access property list identifier.
+!
! AUTHOR
! M. Scot Breitenfeld
! April 21, 2008
!
-! SOURCE
+! Fortran90 Interface:
SUBROUTINE h5olink_f(object_id, new_loc_id, new_link_name, hdferr, lcpl_id, lapl_id)
IMPLICIT NONE
- INTEGER(HID_T), INTENT(IN) :: object_id ! Object to be linked
- INTEGER(HID_T), INTENT(IN) :: new_loc_id ! File or group identifier specifying
- ! location at which object is to be linked.
- CHARACTER(LEN=*), INTENT(IN) :: new_link_name ! Name of link to be created, relative to new_loc_id.
- INTEGER, INTENT(OUT) :: hdferr ! Error code
- ! Success: 0
- ! Failure: -1
- INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id ! Link creation property list identifier.
- INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link creation property list identifier.
+ INTEGER(HID_T) , INTENT(IN) :: object_id
+ INTEGER(HID_T) , INTENT(IN) :: new_loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: new_link_name
+ INTEGER , INTENT(OUT) :: hdferr
+ INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lcpl_id
+ INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lapl_id
!*****
INTEGER(HID_T) :: lapl_id_default
INTEGER(HID_T) :: lcpl_id_default
@@ -115,33 +114,33 @@ CONTAINS
!
! NAME
! h5oopen_f
+!
! PURPOSE
! Opens an object in an HDF5 file by location identifier and path name.
!
-! INPUTS
-! loc_id - File or group identifier
+! Inputs:
+! loc_id - File or group identifier.
! name - Path to the object, relative to loc_id.
-! OUTPUTS
-! obj_id - Object identifier for the opened object
-! hdferr: - error code
-! Success: 0
-! Failure: -1
-! OPTIONAL PARAMETERS
-! lapl_id - Access property list identifier for the link pointing to the object
+!
+! Outputs:
+! obj_id - Object identifier for the opened object.
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! Optional parameters:
+! lapl_id - Access property list identifier for the link pointing to the object.
!
! AUTHOR
! M. Scot Breitenfeld
! April 18, 2008
-! SOURCE
+!
+! Fortran90 Interface:
SUBROUTINE h5oopen_f(loc_id, name, obj_id, hdferr, lapl_id)
IMPLICIT NONE
- INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier
- CHARACTER(LEN=*), INTENT(IN) :: name ! Path to the object, relative to loc_id
- INTEGER(HID_T), INTENT(OUT) :: obj_id ! Object identifier for the opened object
- INTEGER, INTENT(OUT) :: hdferr ! Error code
- ! Success: 0
- ! Failure: -1
- INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Attribute access property list
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ INTEGER(HID_T) , INTENT(OUT) :: obj_id
+ INTEGER , INTENT(OUT) :: hdferr
+ INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lapl_id
!*****
INTEGER(HID_T) :: lapl_id_default
INTEGER(SIZE_T) :: namelen
@@ -178,20 +177,21 @@ CONTAINS
! PURPOSE
! Closes an object in an HDF5 file.
!
-! INPUTS
-! object_id - Object identifier
-! OUTPUTS
-! hdferr - Returns 0 if successful and -1 if fails
+! Inputs:
+! object_id - Object identifier.
+!
+! Outputs:
+! hdferr - Returns 0 if successful and -1 if fails.
!
! AUTHOR
! M. Scot Breitenfeld
! December 17, 2008
!
-! SOURCE
+! Fortran90 Interface:
SUBROUTINE h5oclose_f(object_id, hdferr)
IMPLICIT NONE
- INTEGER(HID_T), INTENT(IN) :: object_id
- INTEGER, INTENT(OUT) :: hdferr
+ INTEGER(HID_T), INTENT(IN) :: object_id
+ INTEGER , INTENT(OUT) :: hdferr
!*****
INTERFACE
INTEGER FUNCTION h5oclose_c(object_id)
@@ -214,25 +214,25 @@ CONTAINS
! PURPOSE
! Opens an object using its address within an HDF5 file.
!
-! INPUTS
-! loc_id - File or group identifier
-! addr - Object’s address in the file
-! OUTPUTS:
-! obj_id - Object identifier for the opened object
-! hdferr - Returns 0 if successful and -1 if fails
+! Inputs:
+! loc_id - File or group identifier.
+! addr - Object’s address in the file.
+!
+! Outputs:
+! obj_id - Object identifier for the opened object.
+! hdferr - Returns 0 if successful and -1 if fails.
!
! AUTHOR
! M. Scot Breitenfeld
! September 14, 2009
!
-! SOURCE
+! Fortran90 Interface:
SUBROUTINE h5oopen_by_addr_f(loc_id, addr, obj_id, hdferr)
IMPLICIT NONE
- INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier
- INTEGER(HADDR_T), INTENT(IN) :: addr ! Object’s address in the file
- INTEGER(HID_T), INTENT(OUT) :: obj_id ! Object identifier for the opened object
- INTEGER, INTENT(OUT) :: hdferr ! Error code:
- ! 0 on success and -1 on failure
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ INTEGER(HADDR_T), INTENT(IN) :: addr
+ INTEGER(HID_T) , INTENT(OUT) :: obj_id
+ INTEGER , INTENT(OUT) :: hdferr
!*****
INTERFACE
INTEGER FUNCTION h5oopen_by_addr_c(loc_id, addr, obj_id)
@@ -249,7 +249,6 @@ CONTAINS
hdferr = h5oopen_by_addr_c(loc_id, addr, obj_id)
END SUBROUTINE h5oopen_by_addr_f
-
!
!****s* H5O/h5ocopy_f
! NAME
@@ -258,31 +257,31 @@ CONTAINS
! PURPOSE
! Copies an object in an HDF5 file.
!
-! INPUTS
-! src_loc_id - Object identifier indicating the location of the source object to be copied
-! src_name - Name of the source object to be copied
-! dst_loc_id - Location identifier specifying the destination
-! dst_name - Name to be assigned to the new copy
+! Inputs:
+! src_loc_id - Object identifier indicating the location of the source object to be copied.
+! src_name - Name of the source object to be copied.
+! dst_loc_id - Location identifier specifying the destination.
+! dst_name - Name to be assigned to the new copy.
!
-! OPTIONAL PARAMETERS
-! ocpypl_id - Object copy property list
-! lcpl_id - Link creation property list for the new hard link
+! Optional parameters:
+! ocpypl_id - Object copy property list.
+! lcpl_id - Link creation property list for the new hard link.
!
-! OUTPUTS:
-! hdferr - Returns 0 if successful and -1 if fails
+! Outputs:
+! hdferr - Returns 0 if successful and -1 if fails.
!
! AUTHOR
! M. Scot Breitenfeld
! March 14, 2012
!
-! SOURCE
+! Fortran90 Interface:
SUBROUTINE h5ocopy_f(src_loc_id, src_name, dst_loc_id, dst_name, hdferr, ocpypl_id, lcpl_id)
IMPLICIT NONE
- INTEGER(HID_T) , INTENT(IN) :: src_loc_id
- CHARACTER(LEN=*), INTENT(IN) :: src_name
- INTEGER(HID_T) , INTENT(IN) :: dst_loc_id
- CHARACTER(LEN=*), INTENT(IN) :: dst_name
- INTEGER, INTENT(OUT) :: hdferr
+ INTEGER(HID_T) , INTENT(IN) :: src_loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: src_name
+ INTEGER(HID_T) , INTENT(IN) :: dst_loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: dst_name
+ INTEGER , INTENT(OUT) :: hdferr
INTEGER(HID_T) , INTENT(IN), OPTIONAL :: ocpypl_id
INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lcpl_id
!*****
diff --git a/fortran/src/H5Tff.f90 b/fortran/src/H5Tff.f90
index f5369d0..fd857a8 100644
--- a/fortran/src/H5Tff.f90
+++ b/fortran/src/H5Tff.f90
@@ -2050,17 +2050,19 @@ CONTAINS
! h5tcreate_f
!
! PURPOSE
-! Creates a new dataype
+! Creates a new datatype.
!
! INPUTS
-! class - datatype class, possible values are:
-! H5T_COMPOUND_F
-! H5T_ENUM_F
-! H5T_OPAQUE_F
-! size - datattype size
+! class - Datatype class can be one of:
+! H5T_COMPOUND_F
+! H5T_ENUM_F
+! H5T_OPAQUE_F
+! H5T_STRING_F
+!
+! size - Size of the datatype.
! OUTPUTS
-! type_id - datatype identifier
-! hdferr - Returns 0 if successful and -1 if fails
+! type_id - Datatype identifier.
+! hdferr - Returns 0 if successful and -1 if fails
!
! AUTHOR
! Elena Pourmal
@@ -2072,29 +2074,26 @@ CONTAINS
! port). March 7, 2001
! SOURCE
SUBROUTINE h5tcreate_f(class, size, type_id, hdferr)
- IMPLICIT NONE
- INTEGER, INTENT(IN) :: class ! Datatype class can be one of
- ! H5T_COMPOUND_F
- ! H5T_ENUM_F
- ! H5T_OPAQUE_F
- INTEGER(SIZE_T), INTENT(IN) :: size ! Size of the datatype
- INTEGER(HID_T), INTENT(OUT) :: type_id ! Datatype identifier
- INTEGER, INTENT(OUT) :: hdferr ! Error code
+ IMPLICIT NONE
+ INTEGER , INTENT(IN) :: class
+ INTEGER(SIZE_T), INTENT(IN) :: size
+ INTEGER(HID_T) , INTENT(OUT) :: type_id
+ INTEGER , INTENT(OUT) :: hdferr
!*****
- INTERFACE
- INTEGER FUNCTION h5tcreate_c(class, size, type_id)
- USE H5GLOBAL
- !DEC$IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TCREATE_C'::h5tcreate_c
- !DEC$ENDIF
- INTEGER, INTENT(IN) :: class
- INTEGER(SIZE_T), INTENT(IN) :: size
- INTEGER(HID_T), INTENT(OUT) :: type_id
- END FUNCTION h5tcreate_c
- END INTERFACE
+ INTERFACE
+ INTEGER FUNCTION h5tcreate_c(class, size, type_id)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TCREATE_C'::h5tcreate_c
+ !DEC$ENDIF
+ INTEGER, INTENT(IN) :: class
+ INTEGER(SIZE_T), INTENT(IN) :: size
+ INTEGER(HID_T), INTENT(OUT) :: type_id
+ END FUNCTION h5tcreate_c
+ END INTERFACE
- hdferr = h5tcreate_c(class, size, type_id)
- END SUBROUTINE h5tcreate_f
+ hdferr = h5tcreate_c(class, size, type_id)
+ END SUBROUTINE h5tcreate_f
!
!****s* H5T/h5tinsert_f
diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am
index d8cdef9..b261785 100644
--- a/fortran/test/Makefile.am
+++ b/fortran/test/Makefile.am
@@ -67,12 +67,8 @@ fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \
tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90
if FORTRAN_2003_CONDITIONAL_F
-# NAG compiler doesn't like the current tH5E_F03.f90 file since it has only comments
-# and no executable statements.
-# Removed from the list of modules to build. EIP 2012-06-28
-# tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \
- tH5F.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
+ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
endif
diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in
index d13aca4..27198a8 100644
--- a/fortran/test/Makefile.in
+++ b/fortran/test/Makefile.in
@@ -118,9 +118,10 @@ fortranlib_test_1_8_LDADD = $(LDADD)
fortranlib_test_1_8_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \
$(LIBH5F) $(LIBHDF5)
am__fortranlib_test_F03_SOURCES_DIST = fortranlib_test_F03.f90 \
- tH5F.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
+ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
@FORTRAN_2003_CONDITIONAL_F_TRUE@am_fortranlib_test_F03_OBJECTS = fortranlib_test_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.$(OBJEXT) \
+@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5E_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5L_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5P_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5T_F03.$(OBJEXT)
@@ -491,13 +492,8 @@ fortranlib_test_SOURCES = fortranlib_test.f90 \
fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \
tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90
-
-# NAG compiler doesn't like the current tH5E_F03.f90 file since it has only comments
-# and no executable statements.
-# Removed from the list of modules to build. EIP 2012-06-28
-# tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
@FORTRAN_2003_CONDITIONAL_F_TRUE@fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
+@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
fflush1_SOURCES = fflush1.f90
fflush2_SOURCES = fflush2.f90
diff --git a/fortran/test/tH5E_F03.f90 b/fortran/test/tH5E_F03.f90
index e378aa7..04e3190 100644
--- a/fortran/test/tH5E_F03.f90
+++ b/fortran/test/tH5E_F03.f90
@@ -24,11 +24,187 @@
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
! USES
+! liter_cb_mod
!
! CONTAINS SUBROUTINES
+! test_error
!
!*****
! *****************************************
! *** H 5 E T E S T S
! *****************************************
+
+MODULE test_my_hdf5_error_handler
+
+ IMPLICIT NONE
+
+CONTAINS
+
+!/****************************************************************
+!**
+!** my_hdf5_error_handler: Custom error callback routine.
+!**
+!****************************************************************/
+
+ INTEGER FUNCTION my_hdf5_error_handler(estack_id, data_inout) bind(C)
+
+ ! 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
+ INTEGER(HID_T) :: estack_id
+ ! data that was registered with H5Eset_auto_f
+! INTEGER, DIMENSION(1:2) :: data_inout
+ INTEGER :: data_inout
+
+ PRINT*, " "
+ PRINT*, " Subtest: H5Eset_auto_f custom error message with callback, WITH DATA"
+ PRINT*, " -This message should be written to standard out- "
+ PRINT*, " Data Values Passed In =", data_inout
+ PRINT*, " "
+
+ data_inout = 10*data_inout
+
+ my_hdf5_error_handler = 1 ! this is not used by the C routine
+
+ END FUNCTION my_hdf5_error_handler
+
+ INTEGER FUNCTION my_hdf5_error_handler_nodata(estack_id, data_inout) bind(C)
+
+ ! 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
+ INTEGER(HID_T) :: estack_id
+ ! data that was registered with H5Eset_auto_f
+ TYPE(C_PTR) :: data_inout
+
+ PRINT*, " "
+ PRINT*, " Subtest: H5Eset_auto_f custom error message with callback, NO DATA"
+ PRINT*, " -This message should be written to standard out- "
+ PRINT*, " "
+
+ my_hdf5_error_handler_nodata = 1 ! this is not used by the C routine
+
+ END FUNCTION my_hdf5_error_handler_nodata
+
+END MODULE test_my_hdf5_error_handler
+
+SUBROUTINE test_error(total_error)
+
+ USE HDF5
+ USE ISO_C_BINDING
+ USE test_my_hdf5_error_handler
+
+ IMPLICIT NONE
+
+ INTEGER(hid_t), PARAMETER :: FAKE_ID = -1
+ INTEGER :: total_error
+ INTEGER(hid_t) :: file
+ INTEGER(hid_t) :: dataset, space
+ INTEGER(hid_t) :: estack_id
+ INTEGER(hsize_t), DIMENSION(1:2) :: dims
+ CHARACTER(LEN=10) :: FUNC_test_error = "test_error"
+ TYPE(C_FUNPTR) :: old_func
+ TYPE(C_PTR) :: old_data, null_data
+ INTEGER :: error
+ TYPE(C_FUNPTR) :: op
+ INTEGER, DIMENSION(1:100,1:200), TARGET :: ipoints2
+ !! INTEGER, DIMENSION(1:2), TARGET :: my_hdf5_error_handler_data
+ INTEGER, DIMENSION(:), POINTER :: ptr_data
+ INTEGER, TARGET :: my_hdf5_error_handler_data
+ TYPE(C_PTR) :: f_ptr
+ TYPE(C_FUNPTR) :: func
+
+ TYPE(C_PTR), TARGET :: f_ptr1
+ TYPE(C_FUNPTR), TARGET :: func1
+
+ INTEGER, DIMENSION(1:1) :: array_shape
+ LOGICAL :: is_associated
+
+ ! my_hdf5_error_handler_data(1:2) =(/1,2/)
+ my_hdf5_error_handler_data = 99
+ CALL h5fcreate_f("terror.h5", H5F_ACC_TRUNC_F, file, error)
+ CALL check("h5fcreate_f", error, total_error)
+
+ ! Create the data space
+ dims(1) = 10
+ dims(2) = 20
+ CALL H5Screate_simple_f(2, dims, space, error)
+ CALL check("h5screate_simple_f", error, total_error)
+
+ ! ** SET THE CUSTOMIZED PRINTING OF ERROR STACK **
+
+ ! set the customized error handling routine
+ func = c_funloc(my_hdf5_error_handler)
+
+ ! set the data sent to the customized routine
+ f_ptr = c_loc(my_hdf5_error_handler_data)
+
+ ! turn on automatic printing, and use a custom error routine with input data
+ CALL H5Eset_auto_f(1, error, H5E_DEFAULT_F, func, f_ptr)
+
+ ! 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("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)
+
+ ! PRINT*,c_associated(f_ptr1)
+
+ ALLOCATE(ptr_data(1:2))
+ ptr_data = 0
+ array_shape(1) = 2
+ CALL C_F_POINTER(f_ptr1, ptr_data, array_shape)
+
+ ! ptr_data => f_ptr1(1)
+
+ ! PRINT*,ptr_data(1)
+
+!!$ if(old_data != NULL)
+!!$ TEST_ERROR;
+!!$#ifdef H5_USE_16_API
+!!$ if (old_func != (H5E_auto_t)H5Eprint)
+!!$ TEST_ERROR;
+!!$#else /* H5_USE_16_API */
+!!$ if (old_func != (H5E_auto2_t)H5Eprint2)
+!!$ TEST_ERROR;
+!!$#endif /* H5_USE_16_API */
+
+
+ ! set the customized error handling routine
+ func = c_funloc(my_hdf5_error_handler_nodata)
+ ! set the data sent to the customized routine as null
+ f_ptr = C_NULL_PTR
+ ! turn on automatic printing, and use a custom error routine with no input data
+ 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)
+
+
+ ! turn on automatic printing with h5eprint_f which prints an error stack in the default manner.
+
+ ! func = c_funloc(h5eprint_f)
+ ! CALL H5Eset_auto_f(0, error, H5E_DEFAULT_F, func, C_NULL_PTR)
+
+ CALL H5Eset_auto_f(0, error)
+ CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error)
+
+ CALL H5Eset_auto_f(1, error)
+ CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error)
+
+END SUBROUTINE test_error
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index 6af1ba6..9605c45 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -108,6 +108,51 @@
INTEGER(HID_T) :: decoded_sid1
INTEGER(HID_T) :: decoded_tid1
+ INTEGER(HID_T) :: fixed_str1, fixed_str2
+ LOGICAL :: are_equal
+ INTEGER(SIZE_T), PARAMETER :: str_size = 10
+ INTEGER(SIZE_T) :: query_size
+
+ ! Test h5tcreate_f with H5T_STRING_F option:
+ ! Create fixed-length string in two ways and make sure they are the same
+
+ CALL h5tcopy_f(H5T_FORTRAN_S1, fixed_str1, error)
+ CALL check("h5tcopy_f", error, total_error)
+ CALL h5tset_size_f(fixed_str1, str_size, error)
+ CALL check("h5tset_size_f", error, total_error)
+ CALL h5tset_strpad_f(fixed_str1, H5T_STR_NULLTERM_F, error)
+ CALL check("h5tset_strpad_f", error, total_error)
+
+ CALL h5tcreate_f(H5T_STRING_F, str_size, fixed_str2, error)
+ CALL check("h5tcreate_f", error, total_error)
+ CALL h5tset_strpad_f(fixed_str2, H5T_STR_NULLTERM_F, error)
+ CALL check("h5tset_strpad_f", error, total_error)
+
+ CALL h5tequal_f(fixed_str1, fixed_str2, are_equal, error)
+ IF(.NOT.are_equal)THEN
+ CALL check("h5tcreate_f", -1, total_error)
+ ENDIF
+
+ CALL h5tget_size_f(fixed_str1, query_size, error)
+ CALL check("h5tget_size_f", error, total_error)
+
+ IF(query_size.NE.str_size)THEN
+ CALL check("h5tget_size_f", -1, total_error)
+ ENDIF
+
+ CALL h5tget_size_f(fixed_str2, query_size, error)
+ CALL check("h5tget_size_f", error, total_error)
+
+ IF(query_size.NE.str_size)THEN
+ CALL check("h5tget_size_f", -1, total_error)
+ ENDIF
+
+ CALL h5tclose_f(fixed_str1,error)
+ CALL check("h5tclose_f", error, total_error)
+
+ CALL h5tclose_f(fixed_str2,error)
+ CALL check("h5tclose_f", error, total_error)
+
data_dims(1) = dimsize
!
! Initialize data buffer.