summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--fortran/test/fortranlib_test_1_8.f90509
-rw-r--r--fortran/test/tH5A_1_8.f90644
-rw-r--r--fortran/test/tH5G_1_8.f90928
-rw-r--r--fortran/test/tH5O.f902
4 files changed, 149 insertions, 1934 deletions
diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90
index 3dafb55..ac87272 100644
--- a/fortran/test/fortranlib_test_1_8.f90
+++ b/fortran/test/fortranlib_test_1_8.f90
@@ -395,41 +395,6 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
CALL h5sclose_f(decoded_sid1, error)
CALL check("h5sclose_f", error, total_error)
-!!$
-!!$ ret = H5Sclose(decoded_sid1);
-!!$ CHECK(ret, FAIL, "H5Sclose");
-!!$
-!!$ /*-------------------------------------------------------------------------
-!!$ * Test encoding and decoding of null dataspace.
-!!$ *-------------------------------------------------------------------------
-!!$ */
-!!$ sid2 = H5Screate(H5S_NULL);
-!!$ CHECK(sid2, FAIL, "H5Screate");
-!!$
-!!$ /* Encode null data space in a buffer */
-!!$ ret = H5Sencode(sid2, NULL, &null_size);
-!!$ CHECK(ret, FAIL, "H5Sencode");
-!!$
-!!$ if(null_size>0)
-!!$ null_sbuf = (unsigned char*)HDcalloc((size_t)1, null_size);
-!!$
-!!$ ret = H5Sencode(sid2, null_sbuf, &null_size);
-!!$ CHECK(ret, FAIL, "H5Sencode");
-!!$
-!!$ /* Decode from the dataspace buffer and return an object handle */
-!!$ decoded_sid2=H5Sdecode(null_sbuf);
-!!$ CHECK(decoded_sid2, FAIL, "H5Sdecode");
-!!$
-!!$ /* Verify decoded dataspace */
-!!$ space_type = H5Sget_simple_extent_type(decoded_sid2);
-!!$ VERIFY(space_type, H5S_NULL, "H5Sget_simple_extent_type");
-!!$
-!!$ ret = H5Sclose(sid2);
-!!$ CHECK(ret, FAIL, "H5Sclose");
-!!$
-!!$ ret = H5Sclose(decoded_sid2);
-!!$ CHECK(ret, FAIL, "H5Sclose");
-!!$
! /*-------------------------------------------------------------------------
! * Test encoding and decoding of scalar dataspace.
! *-------------------------------------------------------------------------
@@ -480,477 +445,3 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
END SUBROUTINE test_h5s_encode
-!/*-------------------------------------------------------------------------
-! * Function: test_hard_query
-! *
-! * Purpose: Tests H5Tcompiler_conv() for querying whether a conversion is
-! * a hard one.
-! *
-! * Return: Success: 0
-! *
-! * Failure: number of errors
-! *
-! * Programmer: Raymond Lu
-! * Friday, Sept 2, 2005
-! *
-! * Modifications:
-! *
-! *-------------------------------------------------------------------------
-! */
-
-!!$SUBROUTINE test_hard_query(total_error)
-!!$
-!!$ USE HDF5 ! This module contains all necessary modules
-!!$
-!!$ IMPLICIT NONE
-!!$ INTEGER, INTENT(INOUT) :: total_error
-!!$
-!!$ INTEGER :: error
-!!$ LOGICAL :: flag
-!!$
-!!$ WRITE(*,*) "query functions of compiler conversion"
-!!$
-!!$ ! /* Verify the conversion from int to float is a hard conversion. */
-!!$
-!!$ CALL H5Tcompiler_conv_f(H5T_INTEGER_F, H5T_FLOAT_F, flag, error)
-!!$ CALL check("H5Tcompiler_conv", error, total_error)
-!!$ CALL VerifyLogical("H5Tcompiler_conv", flag, .TRUE.,total_error)
-
-!!$ if((ret = H5Tcompiler_conv(H5T_NATIVE_INT, H5T_NATIVE_FLOAT))!=TRUE) {
-!!$ H5_FAILED();
-!!$ printf("Can't query conversion function\n");
-!!$ goto error;
-!!$ }
-
-!!$ /* Unregister the hard conversion from int to float. Verify the conversion
-!!$ * is a soft conversion. */
-!!$ H5Tunregister(H5T_PERS_HARD, NULL, H5T_NATIVE_INT, H5T_NATIVE_FLOAT, H5T_conv_int_float);
-!!$ if((ret = H5Tcompiler_conv(H5T_NATIVE_INT, H5T_NATIVE_FLOAT))!=FALSE) {
-!!$ H5_FAILED();
-!!$ printf("Can't query conversion function\n");
-!!$ goto error;
-!!$ }
-!!$
-!!$ /* Register the hard conversion from int to float. Verify the conversion
-!!$ * is a hard conversion. */
-!!$ H5Tregister(H5T_PERS_HARD, "int_flt", H5T_NATIVE_INT, H5T_NATIVE_FLOAT, H5T_conv_int_float);
-!!$ if((ret = H5Tcompiler_conv(H5T_NATIVE_INT, H5T_NATIVE_FLOAT))!=TRUE) {
-!!$ H5_FAILED();
-!!$ printf("Can't query conversion function\n");
-!!$ goto error;
-!!$ }
-!!$
-!!$ PASSED();
-!!$ reset_hdf5();
-!!$
-!!$ return 0;
-!!$
-!!$END SUBROUTINE test_hard_query
-
-
-!/*-------------------------------------------------------------------------
-! * Function: test_encode
-! *
-! * Purpose: Tests functions of encoding and decoding datatype.
-! *
-! * Return: Success: 0
-! *
-! * Failure: number of errors
-! *
-! * Programmer: Raymond Lu
-! * July 14, 2004
-! *
-! * Modifications:
-! *
-! *-------------------------------------------------------------------------
-! */
-
-!!$SUBROUTINE test_encode(total_error)
-!!$
-!!$ USE HDF5 ! This module contains all necessary modules
-!!$ struct s1 {
-!!$ int a;
-!!$ float b;
-!!$ long c;
-!!$ double d;
-!!$ };
-!!$ IMPLICIT NONE
-!!$ INTEGER, INTENT(INOUT) :: total_error
-!!$ INTEGER(SIZE_T), PARAMETER :: sizechar = 1024
-!!$ INTEGER :: error
-!!$ INTEGER(hid_t) :: file=-1, tid1=-1, tid2=-1
-!!$ INTEGER(hid_t) :: decoded_tid1=-1, decoded_tid2=-1
-!!$ CHARACTER(LEN=1024) :: filename = 'encode.h5'
-!!$ char compnd_type[]="Compound_type", enum_type[]="Enum_type";
-!!$ short enum_val;
-!!$ size_t cmpd_buf_size = 0;
-!!$ size_t enum_buf_size = 0;
-!!$ unsigned char *cmpd_buf=NULL, *enum_buf=NULL;
-!!$ herr_t ret;
-!!$ INTEGER(HID_T) :: dt5_id ! Memory datatype identifier
-!!$
-!!$ INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype
-!!$
-!!$ WRITE(*,*) "functions of encoding and decoding datatypes"
-!!$
-!!$ !/* Create File */
-!!$
-!!$ CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
-!!$ CALL check("H5Fcreate_f", error, total_error)
-!!$
-!!$ !/*-----------------------------------------------------------------------
-!!$ ! * Create compound and enumerate datatypes
-!!$ ! *-----------------------------------------------------------------------
-!!$ ! */
-!!$
-!!$ ! /* Create a compound datatype */
-!!$ CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, error)
-!!$ CALL check("h5tcopy_f", error, total_error)
-!!$ sizechar = 2
-!!$ CALL h5tset_size_f(dt5_id, sizechar, error)
-!!$ CALL check("h5tset_size_f", error, total_error)
-!!$ CALL h5tget_size_f(dt5_id, type_sizec, error)
-!!$ CALL check("h5tget_size_f", error, total_error)
-!!$
-!!$ CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizec, error)
-!!$ CALL check("h5tget_size_f", error, total_error)
-!!$ CALL h5tcreate_f(H5T_COMPOUND_F, type_sizec, dtype_id, error)
-!!$
-!!$
-!!$ if((tid1=H5Tcreate(H5T_COMPOUND, sizeof(struct s1))) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't create datatype!\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tinsert(tid1, "a", HOFFSET(struct s1, a), H5T_NATIVE_INT) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't insert field 'a'\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tinsert(tid1, "b", HOFFSET(struct s1, b), H5T_NATIVE_FLOAT) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't insert field 'b'\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tinsert(tid1, "c", HOFFSET(struct s1, c), H5T_NATIVE_LONG) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't insert field 'c'\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tinsert(tid1, "d", HOFFSET(struct s1, d), H5T_NATIVE_DOUBLE) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't insert field 'd'\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Create a enumerate datatype */
-!!$ if((tid2=H5Tcreate(H5T_ENUM, sizeof(short))) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't create enumerate type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tenum_insert(tid2, "RED", (enum_val=0,&enum_val)) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't insert field into enumeration type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tenum_insert(tid2, "GREEN", (enum_val=1,&enum_val)) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't insert field into enumeration type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tenum_insert(tid2, "BLUE", (enum_val=2,&enum_val)) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't insert field into enumeration type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tenum_insert(tid2, "ORANGE", (enum_val=3,&enum_val)) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't insert field into enumeration type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tenum_insert(tid2, "YELLOW", (enum_val=4,&enum_val)) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't insert field into enumeration type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /*-----------------------------------------------------------------------
-!!$ * Test encoding and decoding compound and enumerate datatypes
-!!$ *-----------------------------------------------------------------------
-!!$ */
-!!$ /* Encode compound type in a buffer */
-!!$ if(H5Tencode(tid1, NULL, &cmpd_buf_size) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't encode compound type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ if(cmpd_buf_size>0)
-!!$ cmpd_buf = (unsigned char*)calloc(1, cmpd_buf_size);
-!!$
-!!$ /* Try decoding bogus buffer */
-!!$ H5E_BEGIN_TRY {
-!!$ ret = H5Tdecode(cmpd_buf);
-!!$ } H5E_END_TRY;
-!!$ if(ret!=FAIL) {
-!!$ H5_FAILED();
-!!$ printf("Decoded bogus buffer!\n");
-!!$ goto error;
-!!$ }
-!!$
-!!$ if(H5Tencode(tid1, cmpd_buf, &cmpd_buf_size) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't encode compound type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Decode from the compound buffer and return an object handle */
-!!$ if((decoded_tid1 = H5Tdecode(cmpd_buf)) < 0)
-!!$ FAIL_PUTS_ERROR("Can't decode compound type\n")
-!!$
-!!$ /* Verify that the datatype was copied exactly */
-!!$ if(H5Tequal(decoded_tid1, tid1)<=0) {
-!!$ H5_FAILED();
-!!$ printf("Datatype wasn't encoded & decoded identically\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Query member number and member index by name, for compound type. */
-!!$ if(H5Tget_nmembers(decoded_tid1)!=4) {
-!!$ H5_FAILED();
-!!$ printf("Can't get member number\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tget_member_index(decoded_tid1, "c")!=2) {
-!!$ H5_FAILED();
-!!$ printf("Can't get correct index number\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$
-!!$ /* Encode enumerate type in a buffer */
-!!$ if(H5Tencode(tid2, NULL, &enum_buf_size) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't encode enumerate type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ if(enum_buf_size>0)
-!!$ enum_buf = (unsigned char*)calloc(1, enum_buf_size);
-!!$
-!!$ if(H5Tencode(tid2, enum_buf, &enum_buf_size) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't encode enumerate type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Decode from the enumerate buffer and return an object handle */
-!!$ if((decoded_tid2=H5Tdecode(enum_buf)) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't decode enumerate type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Verify that the datatype was copied exactly */
-!!$ if(H5Tequal(decoded_tid2, tid2)<=0) {
-!!$ H5_FAILED();
-!!$ printf("Datatype wasn't encoded & decoded identically\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Query member number and member index by name, for enumeration type. */
-!!$ if(H5Tget_nmembers(decoded_tid2)!=5) {
-!!$ H5_FAILED();
-!!$ printf("Can't get member number\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tget_member_index(decoded_tid2, "ORANGE") != 3) {
-!!$ H5_FAILED();
-!!$ printf("Can't get correct index number\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /*-----------------------------------------------------------------------
-!!$ * Commit and reopen the compound and enumerate datatypes
-!!$ *-----------------------------------------------------------------------
-!!$ */
-!!$ /* Commit compound datatype and close it */
-!!$ if(H5Tcommit2(file, compnd_type, tid1, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't commit compound datatype\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tclose(tid1) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't close datatype\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tclose(decoded_tid1) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't close datatype\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ free(cmpd_buf);
-!!$ cmpd_buf_size = 0;
-!!$
-!!$ /* Commit enumeration datatype and close it */
-!!$ if(H5Tcommit2(file, enum_type, tid2, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't commit compound datatype\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tclose(tid2) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't close datatype\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tclose(decoded_tid2) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't close datatype\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ free(enum_buf);
-!!$ enum_buf_size = 0;
-!!$
-!!$ /* Open the dataytpe for query */
-!!$ if((tid1 = H5Topen2(file, compnd_type, H5P_DEFAULT)) < 0)
-!!$ FAIL_STACK_ERROR
-!!$ if((tid2 = H5Topen2(file, enum_type, H5P_DEFAULT)) < 0)
-!!$ FAIL_STACK_ERROR
-!!$
-!!$
-!!$ /* Encode compound type in a buffer */
-!!$ if(H5Tencode(tid1, NULL, &cmpd_buf_size) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't encode compound type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ if(cmpd_buf_size>0)
-!!$ cmpd_buf = (unsigned char*)calloc(1, cmpd_buf_size);
-!!$
-!!$ if(H5Tencode(tid1, cmpd_buf, &cmpd_buf_size) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't encode compound type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Decode from the compound buffer and return an object handle */
-!!$ if((decoded_tid1 = H5Tdecode(cmpd_buf)) < 0)
-!!$ FAIL_PUTS_ERROR("Can't decode compound type\n")
-!!$
-!!$ /* Verify that the datatype was copied exactly */
-!!$ if(H5Tequal(decoded_tid1, tid1)<=0) {
-!!$ H5_FAILED();
-!!$ printf("Datatype wasn't encoded & decoded identically\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Query member number and member index by name, for compound type. */
-!!$ if(H5Tget_nmembers(decoded_tid1)!=4) {
-!!$ H5_FAILED();
-!!$ printf("Can't get member number\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tget_member_index(decoded_tid1, "c")!=2) {
-!!$ H5_FAILED();
-!!$ printf("Can't get correct index number\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /*-----------------------------------------------------------------------
-!!$ * Test encoding and decoding compound and enumerate datatypes
-!!$ *-----------------------------------------------------------------------
-!!$ */
-!!$ /* Encode enumerate type in a buffer */
-!!$ if(H5Tencode(tid2, NULL, &enum_buf_size) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't encode enumerate type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ if(enum_buf_size>0)
-!!$ enum_buf = (unsigned char*)calloc(1, enum_buf_size);
-!!$
-!!$ if(H5Tencode(tid2, enum_buf, &enum_buf_size) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't encode enumerate type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Decode from the enumerate buffer and return an object handle */
-!!$ if((decoded_tid2=H5Tdecode(enum_buf)) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't decode enumerate type\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Verify that the datatype was copied exactly */
-!!$ if(H5Tequal(decoded_tid2, tid2)<=0) {
-!!$ H5_FAILED();
-!!$ printf("Datatype wasn't encoded & decoded identically\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Query member number and member index by name, for enumeration type. */
-!!$ if(H5Tget_nmembers(decoded_tid2)!=5) {
-!!$ H5_FAILED();
-!!$ printf("Can't get member number\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tget_member_index(decoded_tid2, "ORANGE")!=3) {
-!!$ H5_FAILED();
-!!$ printf("Can't get correct index number\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /*-----------------------------------------------------------------------
-!!$ * Close and release
-!!$ *-----------------------------------------------------------------------
-!!$ */
-!!$ /* Close datatype and file */
-!!$ if(H5Tclose(tid1) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't close datatype\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tclose(tid2) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't close datatype\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ if(H5Tclose(decoded_tid1) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't close datatype\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$ if(H5Tclose(decoded_tid2) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't close datatype\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ if(H5Fclose(file) < 0) {
-!!$ H5_FAILED();
-!!$ printf("Can't close file\n");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ free(cmpd_buf);
-!!$ free(enum_buf);
-!!$
-!!$ PASSED();
-!!$ return 0;
-!!$
-!!$ error:
-!!$ H5E_BEGIN_TRY {
-!!$ H5Tclose (tid1);
-!!$ H5Tclose (tid2);
-!!$ H5Tclose (decoded_tid1);
-!!$ H5Tclose (decoded_tid2);
-!!$ H5Fclose (file);
-!!$ } H5E_END_TRY;
-!!$ return 1;
-!!$}
diff --git a/fortran/test/tH5A_1_8.f90 b/fortran/test/tH5A_1_8.f90
index e8278f3..cbd1840 100644
--- a/fortran/test/tH5A_1_8.f90
+++ b/fortran/test/tH5A_1_8.f90
@@ -61,7 +61,7 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
! test_attr equivelent
! ********************
- WRITE(*,*) "TESTING ATTRIBUTES"
+! WRITE(*,*) "TESTING ATTRIBUTES"
CALL H5Pcreate_f(H5P_FILE_ACCESS_F,fapl,error)
CALL check("h5Pcreate_f",error,total_error)
@@ -82,10 +82,10 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
DO i = 1, 2
IF (new_format(i)) THEN
- WRITE(*,*) " - Testing with new file format"
+! WRITE(*,*) " - Testing with new file format"
my_fapl = fapl2
ELSE
- WRITE(*,*) " - Testing with old file format"
+! WRITE(*,*) " - Testing with old file format"
my_fapl = fapl
END IF
CALL test_attr_basic_write(my_fapl, total_error)
@@ -104,10 +104,10 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
IF(new_format(i)) THEN
DO j = 1, 2
IF (use_shared(j)) THEN
- WRITE(*,*) " - Testing with shared attributes"
+! WRITE(*,*) " - Testing with shared attributes"
my_fcpl = fcpl2
ELSE
- WRITE(*,*) " - Testing without shared attributes"
+! WRITE(*,*) " - Testing without shared attributes"
my_fcpl = fcpl
END IF
!!$ CALL test_attr_dense_create(my_fcpl, my_fapl)
@@ -195,12 +195,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
INTEGER, PARAMETER :: NUM_DSETS = 3
INTEGER :: curr_dset
-!!$
-!!$! - - - local declarations - - -
-!!$
-!!$ INTEGER :: max_compact,min_dense,curr_dset,u
-!!$ CHARACTER (LEN=NAME_BUF_SIZE) :: attrname
-!!$
+
INTEGER(HID_T) :: dset1, dset2, dset3
INTEGER(HID_T) :: my_dataset
@@ -221,13 +216,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
data_dims = 0
-!!$ INTEGER :: sid
-!!$ INTEGER :: attr
-!!$ INTEGER :: dcpl
-!!$ INTEGER ::is_empty
-!!$ INTEGER ::is_dense
-!!$
- WRITE(*,*) " - Testing Compact Storage of Attributes with Creation Order Info"
+! WRITE(*,*) " - Testing Compact Storage of Attributes with Creation Order Info"
! /* Create file */
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
@@ -237,7 +226,6 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
CALL H5Pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), error)
CALL check("H5Pset_attr_creation_order",error,total_error)
-! ret = H5Pset_attr_creation_order(dcpl, (H5P_CRT_ORDER_TRACKED | H5P_CRT_ORDER_INDEXED));
! /* Query the attribute creation properties */
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
@@ -246,8 +234,6 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
-! FIX: need to check optional parameters i.e. h5dcreate1/2_f
-
CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error, dcpl_id=dcpl )
CALL check("h5dcreate_f",error,total_error)
@@ -257,10 +243,6 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error, dcpl_id=dcpl )
CALL check("h5dcreate_f",error,total_error)
-!!$ dset1 = H5Dcreate2(fid, DSET1_NAME, H5T_NATIVE_UCHAR, sid, H5P_DEFAULT, dcpl, H5P_DEFAULT)
-!!$ dset2 = H5Dcreate2(fid, DSET2_NAME, H5T_NATIVE_UCHAR, sid, H5P_DEFAULT, dcpl, H5P_DEFAULT)
-!!$ dset3 = H5Dcreate2(fid, DSET3_NAME, H5T_NATIVE_UCHAR, sid, H5P_DEFAULT, dcpl, H5P_DEFAULT)
-
DO curr_dset = 0,NUM_DSETS-1
SELECT CASE (curr_dset)
CASE (0)
@@ -280,9 +262,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
! /* Create attribute */
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
-
- ! attr = H5Acreate2(my_dataset, attrname, H5T_NATIVE_UINT, sid, H5P_DEFAULT, H5P_DEFAULT);
- ! check with the optional information create2 specs.
+
CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error)
CALL check("h5acreate_f",error,total_error)
@@ -326,9 +306,6 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl)
CALL check("h5open_f",error,total_error)
-!!$ fid = H5Fopen(FILENAME, H5F_ACC_RDWR, fapl)
-!!$ CALL CHECK(fid, FAIL, "H5Fopen")
-
CALL h5dopen_f(fid, DSET1_NAME, dset1, error)
CALL check("h5dopen_f",error,total_error)
CALL h5dopen_f(fid, DSET2_NAME, dset2, error)
@@ -399,7 +376,12 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
END SUBROUTINE test_attr_corder_create_compact
SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
-! --------------------------------------------------
+!/****************************************************************
+!**
+!** test_attr_null_space(): Test basic H5A (attribute) code.
+!** Tests storing attribute with "null" dataspace
+!**
+!****************************************************************/
USE HDF5
IMPLICIT NONE
@@ -435,22 +417,17 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
! test: H5Sextent_equal_f
-
data_dims = 0
-! CHARACTER (LEN=NAME_BUF_SIZE) :: attrname
-
-! /* Output message about test being performed */
- WRITE(*,*) " - Testing Storing Attributes with 'null' dataspace"
-! /* Create file */
+ ! /* Output message about test being performed */
+! WRITE(*,*) " - Testing Storing Attributes with 'null' dataspace"
+ ! /* Create file */
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
-! /* Close file */
+ ! /* Close file */
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
-!!$ empty_filesize = h5_get_file_size(FILENAME)
-!!$ IF (empty_filesize < 0) CALL TestErrPrintf("Line %d: file size wrong!\n"C, __LINE__)
! /* Re-open file */
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error)
CALL check("h5open_f",error,total_error)
@@ -469,8 +446,6 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
CALL h5acreate_f(dataset, "null attr", H5T_NATIVE_INTEGER, null_sid, attr, error)
CALL check("h5acreate_f",error,total_error)
-!!$ CALL HDstrcpy(attrname, "null attr")
-!!$ attr = H5Acreate2(dataset, attrname, H5T_NATIVE_UINT, null_sid, H5P_DEFAULT, H5P_DEFAULT)
! /* Try to read data from the attribute */
! /* (shouldn't fail, but should leave buffer alone) */
value(1) = 103
@@ -507,82 +482,19 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
! /* Check the attribute's information */
CALL VERIFY("h5aget_info_f.corder",corder,0,total_error)
-! PRINT*,'f_corder_valid',f_corder_valid
-! CALL Verifylogical("h5aget_info_f.corder_valid",f_corder_valid,.TRUE.,total_error)
-
CALL VERIFY("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error)
CALL h5aget_storage_size_f(attr, storage_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
CALL VERIFY("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error)
CALL h5aclose_f(attr,error)
CALL check("h5aclose_f",error,total_error)
-
-
-!!$ CALL HDstrcpy(attrname, "null attr #2")
-!!$ attr = H5Acreate2(dataset, attrname, H5T_NATIVE_UINT, null_sid, H5P_DEFAULT, H5P_DEFAULT)
-!!$ CALL CHECK(attr, FAIL, "H5Acreate2")
-!!$ value = 23
-!!$ ret = H5Awrite(attr, H5T_NATIVE_UINT, value)
-!!$ CALL CHECK(ret, FAIL, "H5Awrite")
-!!$ CALL VERIFY(value, 23, "H5Awrite")
-!!$ ret = H5Aclose(attr)
-!!$ CALL CHECK(ret, FAIL, "H5Aclose")
-!!$ ret = H5Dclose(dataset)
-!!$ CALL CHECK(ret, FAIL, "H5Dclose")
-!!$ ret = H5Fclose(fid)
-!!$ CALL CHECK(ret, FAIL, "H5Fclose")
-!!$ fid = H5Fopen(FILENAME, H5F_ACC_RDWR, fapl)
-!!$ CALL CHECK(fid, FAIL, "H5Fopen")
-!!$ dataset = H5Dopen2(fid, DSET1_NAME, H5P_DEFAULT)
-!!$ CALL CHECK(dataset, FAIL, "H5Dopen2")
-!!$ CALL HDstrcpy(attrname, "null attr #2")
-!!$ attr = H5Aopen(dataset, attrname, H5P_DEFAULT)
-!!$ CALL CHECK(attr, FAIL, "H5Aopen")
-!!$ value = 23
-!!$ ret = H5Aread(attr, H5T_NATIVE_UINT, value)
-!!$ CALL CHECK(ret, FAIL, "H5Aread")
-!!$ CALL VERIFY(value, 23, "H5Aread")
-!!$ attr_sid = H5Aget_space(attr)
-!!$ CALL CHECK(attr_sid, FAIL, "H5Aget_space")
-!!$ cmp = H5Sextent_equal(attr_sid, null_sid)
-!!$ CALL CHECK(cmp, FAIL, "H5Sextent_equal")
-!!$ CALL VERIFY(cmp, TRUE, "H5Sextent_equal")
-
CALL H5Sclose_f(attr_sid, error)
CALL check("H5Sclose_f",error,total_error)
-
-
-!!$ ret = H5Sclose(attr_sid)
-!!$ CALL CHECK(ret, FAIL, "H5Sclose")
-!!$ storage_size = H5Aget_storage_size(attr)
-!!$ CALL VERIFY(storage_size, 0, "H5Aget_storage_size")
-!!$ ret = H5Aget_info(attr, ainfo)
-!!$ CALL CHECK(ret, FAIL, "H5Aget_info")
-!!$ CALL VERIFY(ainfo%data_size, storage_size, "H5Aget_info")
-!!$ ret = H5Aclose(attr)
-!!$ CALL CHECK(ret, FAIL, "H5Aclose")
-!!$ CALL HDstrcpy(attrname, "null attr")
-!!$ attr = H5Aopen(dataset, attrname, H5P_DEFAULT)
-!!$ CALL CHECK(attr, FAIL, "H5Aopen")
-!!$ value = 23
-!!$ ret = H5Awrite(attr, H5T_NATIVE_UINT, value)
-!!$ CALL CHECK(ret, FAIL, "H5Awrite")
-!!$ CALL VERIFY(value, 23, "H5Awrite")
-
-
-!!$ CALL H5Aclose_f(attr, error)
-!!$ CALL check("H5Aclose_f", error,total_error)
-!!$ CALL H5Ddelete_f(fid, DSET1_NAME, H5P_DEFAULT_F, error)
-!!$ CALL check("H5Aclose_f", error,total_error)
CALL H5Dclose_f(dataset, error)
CALL check("H5Dclose_f", error,total_error)
-!!$ ret = H5delete(fid, DSET1_NAME, H5P_DEFAULT)
-!!$ CALL CHECK(ret, FAIL, "H5Ldelete")
-
-! TESTING1
CALL H5Fclose_f(fid, error)
CALL check("H5Fclose_f", error,total_error)
@@ -593,9 +505,6 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
CALL H5Sclose_f(null_sid, error)
CALL check("H5Sclose_f", error,total_error)
-!!$ filesize = h5_get_file_size(FILENAME)
-!!$ CALL VERIFY(filesize, empty_filesize, "h5_get_file_size")
-
END SUBROUTINE test_attr_null_space
@@ -659,11 +568,11 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
! /* Loop over using index for creation order value */
DO i = 1, 2
! /* Print appropriate test message */
- IF(use_index(i))THEN
- WRITE(*,*) " - Testing Creating Attributes By Name w/Creation Order Index"
- ELSE
- WRITE(*,*) " - Testing Creating Attributes By Name w/o Creation Order Index"
- ENDIF
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,*) " - Testing Creating Attributes By Name w/Creation Order Index"
+!!$ ELSE
+!!$ WRITE(*,*) " - Testing Creating Attributes By Name w/o Creation Order Index"
+!!$ ENDIF
! /* Create file */
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
@@ -755,7 +664,6 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
CALL attr_open_check(fid, dsetname, my_dataset, u, total_error)
- ! CHECK(ret, FAIL, "attr_open_check");
ENDDO
@@ -771,8 +679,6 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
CASE (2)
my_dataset = dset3
dsetname = DSET3_NAME
-! CASE DEFAULT
-! CALL HDassert(0.AND."Toomanydatasets!")
END SELECT
! /* Create more attributes, to push into dense form */
@@ -909,17 +815,6 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
INTEGER(HSIZE_T) :: htmp
data_dims = 0
-!!$ htri_t is_empty; /* Are there any attributes? */
-!!$ htri_t is_dense; /* Are attributes stored densely? */
-!!$ hsize_t nattrs; /* Number of attributes on object */
-!!$ hsize_t name_count; /* # of records in name index */
-!!$ hsize_t corder_count; /* # of records in creation order index */
-!!$ hbool_t use_index; /* Use index on creation order values */
-!!$ char attrname[NAME_BUF_SIZE]; /* Name of attribute */
-!!$ char tmpname[NAME_BUF_SIZE]; /* Temporary attribute name */
-!!$ unsigned curr_dset; /* Current dataset to work on */
-!!$ unsigned u; /* Local index variable */
-!!$ herr_t ret; /* Generic return value */
! /* Create dataspace for dataset & attributes */
@@ -942,11 +837,11 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
DO i = 1, 2
! /* Output message about test being performed */
- IF(use_index(i))THEN
- WRITE(*,'(A72)') " - Testing Querying Attribute Info By Index w/Creation Order Index"
- ELSE
- WRITE(*,'(A74)') " - Testing Querying Attribute Info By Index w/o Creation Order Index"
- ENDIF
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(A72)') " - Testing Querying Attribute Info By Index w/Creation Order Index"
+!!$ ELSE
+!!$ WRITE(*,'(A74)') " - Testing Querying Attribute Info By Index w/o Creation Order Index"
+!!$ ENDIF
! /* Create file */
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
@@ -1058,78 +953,6 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
!CHECK(ret, FAIL, "attr_info_by_idx_check");
ENDDO
- ! /* Verify state of object */
-!!$ ret = H5O_num_attrs_test(my_dataset, &nattrs);
-!!$ CHECK(ret, FAIL, "H5O_num_attrs_test");
-!!$ VERIFY(nattrs, max_compact, "H5O_num_attrs_test");
-!!$ is_empty = H5O_is_attr_empty_test(my_dataset);
-!!$ VERIFY(is_empty, FALSE, "H5O_is_attr_empty_test");
-!!$ is_dense = H5O_is_attr_dense_test(my_dataset);
-!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test");
-
- ! /* Check for out of bound offset queries */
-!!$ ret = H5Aget_info_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_INC, (hsize_t)u, &ainfo, H5P_DEFAULT);
-!!$ VERIFY(ret, FAIL, "H5Aget_info_by_idx");
-!!$ ret = H5Aget_info_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)u, &ainfo, H5P_DEFAULT);
-!!$ VERIFY(ret, FAIL, "H5Aget_info_by_idx");
-!!$ ret = H5Aget_name_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_INC, (hsize_t)u, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT);
-!!$ VERIFY(ret, FAIL, "H5Aget_name_by_idx");
-!!$
-!!$ /* Create more attributes, to push into dense form */
-!!$ for(; u < (max_compact * 2); u++) {
-!!$ /* Create attribute */
-!!$ sprintf(attrname, "attr %02u", u);
-!!$ attr = H5Acreate2(my_dataset, attrname, H5T_NATIVE_UINT, sid, H5P_DEFAULT, H5P_DEFAULT);
-!!$ CHECK(attr, FAIL, "H5Acreate2");
-!!$
-!!$ /* Write data into the attribute */
-!!$ ret = H5Awrite(attr, H5T_NATIVE_UINT, &u);
-!!$ CHECK(ret, FAIL, "H5Awrite");
-!!$
-!!$ /* Close attribute */
-!!$ ret = H5Aclose(attr);
-!!$ CHECK(ret, FAIL, "H5Aclose");
-!!$
-!!$ /* Verify state of object */
-!!$ is_dense = H5O_is_attr_dense_test(my_dataset);
-!!$ VERIFY(is_dense, (new_format ? TRUE : FALSE), "H5O_is_attr_dense_test");
-!!$
-!!$ /* Verify information for new attribute */
-!!$ ret = attr_info_by_idx_check(my_dataset, attrname, (hsize_t)u, use_index);
-!!$ CHECK(ret, FAIL, "attr_info_by_idx_check");
-!!$ } /* end for */
-!!$
-!!$ /* Verify state of object */
-!!$ ret = H5O_num_attrs_test(my_dataset, &nattrs);
-!!$ CHECK(ret, FAIL, "H5O_num_attrs_test");
-!!$ VERIFY(nattrs, (max_compact * 2), "H5O_num_attrs_test");
-!!$ is_empty = H5O_is_attr_empty_test(my_dataset);
-!!$ VERIFY(is_empty, FALSE, "H5O_is_attr_empty_test");
-!!$ is_dense = H5O_is_attr_dense_test(my_dataset);
-!!$ VERIFY(is_dense, (new_format ? TRUE : FALSE), "H5O_is_attr_dense_test");
-!!$
-!!$ if(new_format) {
-!!$ /* Retrieve & verify # of records in the name & creation order indices */
-!!$ ret = H5O_attr_dense_info_test(my_dataset, &name_count, &corder_count);
-!!$ CHECK(ret, FAIL, "H5O_attr_dense_info_test");
-!!$ if(use_index)
-!!$ VERIFY(name_count, corder_count, "H5O_attr_dense_info_test");
-!!$ VERIFY(name_count, (max_compact * 2), "H5O_attr_dense_info_test");
-!!$ } /* end if */
-!!$
-!!$ /* Check for out of bound offset queries */
-!!$ ret = H5Aget_info_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_INC, (hsize_t)u, &ainfo, H5P_DEFAULT);
-!!$ VERIFY(ret, FAIL, "H5Aget_info_by_idx");
-!!$ ret = H5Aget_info_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)u, &ainfo, H5P_DEFAULT);
-!!$ VERIFY(ret, FAIL, "H5Aget_info_by_idx");
-!!$ ret = H5Aget_name_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_INC, (hsize_t)u, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT);
-!!$ VERIFY(ret, FAIL, "H5Aget_name_by_idx");
-!!$ } /* end for */
-!!$
-
-!!$ } /* end for */
-!!$
-
ENDDO
@@ -1179,18 +1002,6 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
CHARACTER(LEN=7) :: tmpname
INTEGER(HSIZE_T) :: hzero = 0_HSIZE_T
-!!$
-!!$ INTEGER :: const
-!!$ INTEGER :: har
-!!$ INTEGER :: attrname
-!!$ INTEGER :: hsize_t
-!!$ INTEGER :: hbool_t
-!!$ INTEGER :: se_index
-!!$ INTEGER :: old_nerrs
-!!$ CHARACTER (LEN=NAME_BUF_SIZE) :: tmpname
-!!$ ainfo
-!!$ ret
-!!$ old_nerrs = GetTestNumErrs()
! /* Verify the information for first attribute, in increasing creation order */
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, hzero, &
@@ -1225,15 +1036,12 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
! * index.
! */
IF (use_index) THEN
- ! CALL HDmemset(ainfo, 0, SIZEOF(ainfo)
! /* Verify the information for first attribute, in native creation order */
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
- ! CALL HDmemset(ainfo, 0, SIZEOF(ainfo)
-
! /* Verify the information for new attribute, in native creation order */
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, n, &
f_corder_valid, corder, cset, data_size, error)
@@ -1241,7 +1049,6 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
! /* Verify the name for new link, in increasing native order */
- ! CALL HDmemset(tmpname, 0, (size_t))
CALL h5aget_name_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, &
n, tmpname, error) ! check with no optional parameters
CALL check("h5aget_name_by_idx_f",error,total_error)
@@ -1259,7 +1066,6 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
CALL check("h5aget_info_by_idx_f",error,total_error)
CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
- ! CALL HDmemset(ainfo, 0, SIZEOF(ainfo)
!EP CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, 0_HSIZE_T, &
! -- CHECK PASSING AN INTEGER CONSTANT IN DIFFERENT FORMS --
@@ -1285,37 +1091,27 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
CALL check("h5aget_info_by_idx_f",error,total_error)
CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
-!!$ CALL HDmemset(tmpname, 0, (size_t))
-!!$ ret = H5Aget_name_by_idx(obj_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT)
-!!$ CALL CHECK(ret, FAIL, "H5Aget_name_by_idx")
-!!$ IF (HDstrcmp(attrname, tmpname)) CALL TestErrPrintf("Line %d: attribute name size wrong!\n"C, __LINE__)
-!!$ CALL HDmemset(ainfo, 0, SIZEOF(ainfo)
!EP CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_HSIZE_T, &
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
-!!$ CALL HDmemset(ainfo, 0, SIZEOF(ainfo)
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, n, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
-!!$ CALL HDmemset(tmpname, 0, (size_t))
!!$ ret = H5Aget_name_by_idx(obj_id, ".", H5_INDEX_NAME, H5_ITER_INC, n, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT)
!!$ CALL CHECK(ret, FAIL, "H5Aget_name_by_idx")
!!$ IF (HDstrcmp(attrname, tmpname)) CALL TestErrPrintf("Line %d: attribute name size wrong!\n"C, __LINE__)
-!!$ CALL HDmemset(ainfo, 0, SIZEOF(ainfo)
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_DEC_F, n, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
-!!$ CALL HDmemset(ainfo, 0, SIZEOF(ainfo)
!EP CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_DEC_F, 0_HSIZE_T, &
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_DEC_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
-!!$ CALL HDmemset(tmpname, 0, (size_t))
!!$ ret = H5Aget_name_by_idx(obj_id, ".", H5_INDEX_NAME, H5_ITER_DEC, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT)
!!$ CALL CHECK(ret, FAIL, "H5Aget_name_by_idx")
!!$ IF (HDstrcmp(attrname, tmpname)) CALL TestErrPrintf("Line %d: attribute name size wrong!\n"C, __LINE__)
@@ -1390,9 +1186,8 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
INTEGER :: arank = 1 ! Attribure rank
! /* Output message about test being performed */
- WRITE(*,*) " - Testing Renaming Shared & Unshared Attributes in Compact & Dense Storage"
+! WRITE(*,*) " - Testing Renaming Shared & Unshared Attributes in Compact & Dense Storage"
!!$ /* Initialize "big" attribute data */
-!!$ CALL HDmemset(big_value, 1, SIZEOF(big_value)
! /* Create dataspace for dataset */
CALL h5screate_f(H5S_SCALAR_F, sid, error)
@@ -1420,26 +1215,18 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
! /* Make attributes > 500 bytes shared */
CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,1,error)
CALL check("H5Pset_shared_mesg_nindexes_f",error, total_error)
-!!$ CHECK_I(ret, "H5Pset_shared_mesg_nindexes");
CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error)
CALL check(" H5Pset_shared_mesg_index_f",error, total_error)
-!!$ CHECK_I(ret, "H5Pset_shared_mesg_index");
ELSE
! /* Set up copy of file creation property list */
CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,3,error)
-!!$
-!!$ CHECK_I(ret, "H5Pset_shared_mesg_nindexes");
-!!$
+
! /* Make attributes > 500 bytes shared */
- CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error)
-!!$ CHECK_I(ret, "H5Pset_shared_mesg_index");
-!!$
+ CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error)
! /* Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-) */
CALL H5Pset_shared_mesg_index_f(my_fcpl, 1, H5O_SHMESG_DTYPE_FLAG_F, 1,error)
-!!$ CHECK_I(ret, "H5Pset_shared_mesg_index");
CALL H5Pset_shared_mesg_index_f(my_fcpl, 2, H5O_SHMESG_SDSPACE_FLAG_F, 1,error)
-!!$ CHECK_I(ret, "H5Pset_shared_mesg_index");
ENDIF
! /* Create file */
@@ -1453,12 +1240,6 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
-!!$
-!!$ /* Get size of file */
-!!$ empty_filesize = h5_get_file_size(FILENAME);
-!!$ if(empty_filesize < 0)
-!!$ TestErrPrintf("Line %d: file size wrong!\n", __LINE__);
-
! /* Re-open file */
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl)
CALL check("h5open_f",error,total_error)
@@ -1537,7 +1318,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
CALL h5acreate_f(dataset, attrname, attr_tid, big_sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
-!!$
+
! Check that attribute is shared */
!!$ is_shared = H5A_is_shared_test(attr);
!!$ VERIFY(is_shared, TRUE, "H5A_is_shared_test");
@@ -1838,9 +1619,9 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
INTEGER(HID_T), INTENT(IN) :: fapl
INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=8) :: FileName = "tattr.h5"
- INTEGER(HID_T) :: fid
- INTEGER(HID_T) :: dcpl
- INTEGER(HID_T) :: sid
+ INTEGER(HID_T) :: fid ! /* HDF5 File ID */
+ INTEGER(HID_T) :: dcpl ! /* Dataset creation property list ID */
+ INTEGER(HID_T) :: sid ! /* Dataspace ID */
CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1"
CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2"
@@ -1879,39 +1660,13 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
INTEGER :: idx_type
INTEGER :: order
- INTEGER :: u
+ INTEGER :: u ! /* Local index variable */
INTEGER :: Input1
INTEGER(HSIZE_T) :: hzero = 0_HSIZE_T
INTEGER :: minusone = -1
data_dims = 0
-!!$test_attr_delete_by_idx(hbool_t new_format, hid_t fcpl, hid_t fapl)
-!!${
-!!$ hid_t fid; /* HDF5 File ID */
-!!$ hid_t dset1, dset2, dset3; /* Dataset IDs */
-!!$ hid_t my_dataset; /* Current dataset ID */
-!!$ hid_t sid; /* Dataspace ID */
-!!$ hid_t attr; /* Attribute ID */
-!!$ hid_t dcpl; /* Dataset creation property list ID */
-!!$ H5A_info_t ainfo; /* Attribute information */
-!!$ unsigned max_compact; /* Maximum # of links to store in group compactly */
-!!$ unsigned min_dense; /* Minimum # of links to store in group "densely" */
-!!$ htri_t is_empty; /* Are there any attributes? */
-!!$ htri_t is_dense; /* Are attributes stored densely? */
-!!$ hsize_t nattrs; /* Number of attributes on object */
-!!$ hsize_t name_count; /* # of records in name index */
-!!$ hsize_t corder_count; /* # of records in creation order index */
-!!$ H5_index_t idx_type; /* Type of index to operate on */
-!!$ H5_iter_order_t order; /* Order within in the index */
-!!$ hbool_t use_index; /* Use index on creation order values */
-!!$ char attrname[NAME_BUF_SIZE]; /* Name of attribute */
-!!$ char tmpname[NAME_BUF_SIZE]; /* Temporary attribute name */
-!!$ unsigned curr_dset; /* Current dataset to work on */
-!!$ unsigned u; /* Local index variable */
-!!$ herr_t ret; /* Generic return value */
-!!$
-
! /* Create dataspace for dataset & attributes */
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
@@ -1935,39 +1690,39 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
DO i = 1, 2
! /* Print appropriate test message */
- IF(idx_type .EQ. H5_INDEX_CRT_ORDER_F)THEN
- IF(order .EQ. H5_ITER_INC_F) THEN
- IF(use_index(i))THEN
- WRITE(*,'(A102)') &
- " - Testing Deleting Attribute By Creation Order Index in Increasing Order w/Creation Order Index"
- ELSE
- WRITE(*,'(A104)') &
- " - Testing Deleting Attribute By Creation Order Index in Increasing Order w/o Creation Order Index"
- ENDIF
- ELSE
- IF(use_index(i))THEN
- WRITE(*,'(A102)') &
- " - Testing Deleting Attribute By Creation Order Index in Decreasing Order w/Creation Order Index"
- ELSE
- WRITE(*,'(A104)') &
- " - Testing Deleting Attribute By Creation Order Index in Decreasing Order w/o Creation Order Index"
- ENDIF
- ENDIF
- ELSE
- IF(order .EQ. H5_ITER_INC_F)THEN
- IF(use_index(i))THEN
- WRITE(*,'(7X,A86)')"- Testing Deleting Attribute By Name Index in Increasing Order w/Creation Order Index"
- ELSE
- WRITE(*,'(7X,A88)')"- Testing Deleting Attribute By Name Index in Increasing Order w/o Creation Order Index"
- ENDIF
- ELSE
- IF(use_index(i))THEN
- WRITE(*,'(7X,A86)') "- Testing Deleting Attribute By Name Index in Decreasing Order w/Creation Order Index"
- ELSE
- WRITE(*,'(7X,A88)') "- Testing Deleting Attribute By Name Index in Decreasing Order w/o Creation Order Index"
- ENDIF
- ENDIF
- ENDIF
+!!$ IF(idx_type .EQ. H5_INDEX_CRT_ORDER_F)THEN
+!!$ IF(order .EQ. H5_ITER_INC_F) THEN
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(A102)') &
+!!$ " - Testing Deleting Attribute By Creation Order Index in Increasing Order w/Creation Order Index"
+!!$ ELSE
+!!$ WRITE(*,'(A104)') &
+!!$ " - Testing Deleting Attribute By Creation Order Index in Increasing Order w/o Creation Order Index"
+!!$ ENDIF
+!!$ ELSE
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(A102)') &
+!!$ " - Testing Deleting Attribute By Creation Order Index in Decreasing Order w/Creation Order Index"
+!!$ ELSE
+!!$ WRITE(*,'(A104)') &
+!!$ " - Testing Deleting Attribute By Creation Order Index in Decreasing Order w/o Creation Order Index"
+!!$ ENDIF
+!!$ ENDIF
+!!$ ELSE
+!!$ IF(order .EQ. H5_ITER_INC_F)THEN
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(7X,A86)')"- Testing Deleting Attribute By Name Index in Increasing Order w/Creation Order Index"
+!!$ ELSE
+!!$ WRITE(*,'(7X,A88)')"- Testing Deleting Attribute By Name Index in Increasing Order w/o Creation Order Index"
+!!$ ENDIF
+!!$ ELSE
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(7X,A86)') "- Testing Deleting Attribute By Name Index in Decreasing Order w/Creation Order Index"
+!!$ ELSE
+!!$ WRITE(*,'(7X,A88)') "- Testing Deleting Attribute By Name Index in Decreasing Order w/o Creation Order Index"
+!!$ ENDIF
+!!$ ENDIF
+!!$ ENDIF
! /* Create file */
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
@@ -2226,16 +1981,10 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error)
CALL check("H5Adelete_by_idx_f",error,total_error)
-
-
! /* Verify the attribute information for first attribute in appropriate order */
-!!$ HDmemset(&ainfo, 0, sizeof(ainfo));
-
CALL h5aget_info_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), &
f_corder_valid, corder, cset, data_size, error)
-
-
IF(new_format)THEN
IF(order.EQ.H5_ITER_INC_F)THEN
CALL VERIFY("H5Aget_info_by_idx_f",corder,u + 1,total_error)
@@ -2244,7 +1993,6 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
CALL VERIFY("H5Aget_info_by_idx_f",corder, ((max_compact * 2) - (u + 2)), total_error)
ENDIF
-
! /* Verify the name for first attribute in appropriate order */
! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
@@ -2277,168 +2025,6 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
ENDDO
-
-!!$
-!!$
-!!$ /* Delete attributes in middle */
-!!$
-!!$
-!!$ /* Work on all the datasets */
-!!$ for(curr_dset = 0; curr_dset < NUM_DSETS; curr_dset++) {
-!!$ switch(curr_dset) {
-!!$ case 0:
-!!$ my_dataset = dset1;
-!!$ break;
-!!$
-!!$ case 1:
-!!$ my_dataset = dset2;
-!!$ break;
-!!$
-!!$ case 2:
-!!$ my_dataset = dset3;
-!!$ break;
-!!$
-!!$ default:
-!!$ HDassert(0 && "Too many datasets!");
-!!$ } /* end switch */
-!!$
-!!$ /* Create attributes, to push into dense form */
-!!$ for(u = 0; u < (max_compact * 2); u++) {
-!!$ /* Create attribute */
-!!$ sprintf(attrname, "attr %02u", u);
-!!$ attr = H5Acreate2(my_dataset, attrname, H5T_NATIVE_UINT, sid, H5P_DEFAULT, H5P_DEFAULT);
-!!$ CHECK(attr, FAIL, "H5Acreate2");
-!!$
-!!$ /* Write data into the attribute */
-!!$ ret = H5Awrite(attr, H5T_NATIVE_UINT, &u);
-!!$ CHECK(ret, FAIL, "H5Awrite");
-!!$
-!!$ /* Close attribute */
-!!$ ret = H5Aclose(attr);
-!!$ CHECK(ret, FAIL, "H5Aclose");
-!!$
-!!$ /* Verify state of object */
-!!$ if(u >= max_compact) {
-!!$ is_dense = H5O_is_attr_dense_test(my_dataset);
-!!$ VERIFY(is_dense, (new_format ? TRUE : FALSE), "H5O_is_attr_dense_test");
-!!$ } /* end if */
-!!$
-!!$ /* Verify information for new attribute */
-!!$ ret = attr_info_by_idx_check(my_dataset, attrname, (hsize_t)u, use_index);
-!!$ CHECK(ret, FAIL, "attr_info_by_idx_check");
-!!$ } /* end for */
-!!$ } /* end for */
-!!$
-!!$ /* Work on all the datasets */
-!!$ for(curr_dset = 0; curr_dset < NUM_DSETS; curr_dset++) {
-!!$ switch(curr_dset) {
-!!$ case 0:
-!!$ my_dataset = dset1;
-!!$ break;
-!!$
-!!$ case 1:
-!!$ my_dataset = dset2;
-!!$ break;
-!!$
-!!$ case 2:
-!!$ my_dataset = dset3;
-!!$ break;
-!!$
-!!$ default:
-!!$ HDassert(0 && "Too many datasets!");
-!!$ } /* end switch */
-!!$
-!!$ /* Delete every other attribute from dense storage, in appropriate order */
-!!$ for(u = 0; u < max_compact; u++) {
-!!$ /* Delete attribute */
-!!$ ret = H5Adelete_by_idx(my_dataset, ".", idx_type, order, (hsize_t)u, H5P_DEFAULT);
-!!$ CHECK(ret, FAIL, "H5Adelete_by_idx");
-!!$
-!!$ /* Verify the attribute information for first attribute in appropriate order */
-!!$ HDmemset(&ainfo, 0, sizeof(ainfo));
-!!$ ret = H5Aget_info_by_idx(my_dataset, ".", idx_type, order, (hsize_t)u, &ainfo, H5P_DEFAULT);
-!!$ if(new_format) {
-!!$ if(order == H5_ITER_INC) {
-!!$ VERIFY(ainfo.corder, ((u * 2) + 1), "H5Aget_info_by_idx");
-!!$ } /* end if */
-!!$ else {
-!!$ VERIFY(ainfo.corder, ((max_compact * 2) - ((u * 2) + 2)), "H5Aget_info_by_idx");
-!!$ } /* end else */
-!!$ } /* end if */
-!!$
-!!$ /* Verify the name for first attribute in appropriate order */
-!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
-!!$ ret = H5Aget_name_by_idx(my_dataset, ".", idx_type, order, (hsize_t)u, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT);
-!!$ if(order == H5_ITER_INC)
-!!$ sprintf(attrname, "attr %02u", ((u * 2) + 1));
-!!$ else
-!!$ sprintf(attrname, "attr %02u", ((max_compact * 2) - ((u * 2) + 2)));
-!!$ ret = HDstrcmp(attrname, tmpname);
-!!$ VERIFY(ret, 0, "H5Aget_name_by_idx");
-!!$ } /* end for */
-!!$ } /* end for */
-!!$
-!!$ /* Work on all the datasets */
-!!$ for(curr_dset = 0; curr_dset < NUM_DSETS; curr_dset++) {
-!!$ switch(curr_dset) {
-!!$ case 0:
-!!$ my_dataset = dset1;
-!!$ break;
-!!$
-!!$ case 1:
-!!$ my_dataset = dset2;
-!!$ break;
-!!$
-!!$ case 2:
-!!$ my_dataset = dset3;
-!!$ break;
-!!$
-!!$ default:
-!!$ HDassert(0 && "Too many datasets!");
-!!$ } /* end switch */
-!!$
-!!$ /* Delete remaining attributes from dense storage, in appropriate order */
-!!$ for(u = 0; u < (max_compact - 1); u++) {
-!!$ /* Delete attribute */
-!!$ ret = H5Adelete_by_idx(my_dataset, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT);
-!!$ CHECK(ret, FAIL, "H5Adelete_by_idx");
-!!$
-!!$ /* Verify the attribute information for first attribute in appropriate order */
-!!$ HDmemset(&ainfo, 0, sizeof(ainfo));
-!!$ ret = H5Aget_info_by_idx(my_dataset, ".", idx_type, order, (hsize_t)0, &ainfo, H5P_DEFAULT);
-!!$ if(new_format) {
-!!$ if(order == H5_ITER_INC) {
-!!$ VERIFY(ainfo.corder, ((u * 2) + 3), "H5Aget_info_by_idx");
-!!$ } /* end if */
-!!$ else {
-!!$ VERIFY(ainfo.corder, ((max_compact * 2) - ((u * 2) + 4)), "H5Aget_info_by_idx");
-!!$ } /* end else */
-!!$ } /* end if */
-!!$
-!!$ /* Verify the name for first attribute in appropriate order */
-!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
-!!$ ret = H5Aget_name_by_idx(my_dataset, ".", idx_type, order, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT);
-!!$ if(order == H5_ITER_INC)
-!!$ sprintf(attrname, "attr %02u", ((u * 2) + 3));
-!!$ else
-!!$ sprintf(attrname, "attr %02u", ((max_compact * 2) - ((u * 2) + 4)));
-!!$ ret = HDstrcmp(attrname, tmpname);
-!!$ VERIFY(ret, 0, "H5Aget_name_by_idx");
-!!$ } /* end for */
-!!$
-!!$ /* Delete last attribute */
-!!$ ret = H5Adelete_by_idx(my_dataset, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT);
-!!$ CHECK(ret, FAIL, "H5Adelete_by_idx");
-!!$
-!!$ /* Verify state of attribute storage (empty) */
-!!$ is_empty = H5O_is_attr_empty_test(my_dataset);
-!!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test");
-!!$
-!!$ /* Check for deletion on empty attribute storage again */
-!!$ ret = H5Adelete_by_idx(my_dataset, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT);
-!!$ VERIFY(ret, FAIL, "H5Adelete_by_idx");
-!!$ } /* end for */
-
! /* Close Datasets */
CALL h5dclose_f(dset1, error)
CALL check("h5dclose_f",error,total_error)
@@ -2523,11 +2109,9 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
INTEGER :: arank = 1 ! Attribure rank
! /* Output message about test being performed */
- WRITE(*,*) " - Testing Deleting Shared & Unshared Attributes in Compact & Dense Storage"
+! WRITE(*,*) " - Testing Deleting Shared & Unshared Attributes in Compact & Dense Storage"
! /* Initialize "big" attribute DATA */
-!!$ HDmemset(big_value, 1, sizeof(big_value));
-!!$
! /* Create dataspace for dataset */
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
@@ -2564,16 +2148,10 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
ELSE
! /* Set up copy of file creation property list */
CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,3,error)
-!!$
-!!$ CHECK_I(ret, "H5Pset_shared_mesg_nindexes");
-!!$
! /* Make attributes > 500 bytes shared */
CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error)
-!!$ CHECK_I(ret, "H5Pset_shared_mesg_index");
-!!$
! /* Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-) */
CALL H5Pset_shared_mesg_index_f(my_fcpl, 1, H5O_SHMESG_DTYPE_FLAG_F, 1,error)
-!!$ CHECK_I(ret, "H5Pset_shared_mesg_index");
CALL H5Pset_shared_mesg_index_f(my_fcpl, 2, H5O_SHMESG_SDSPACE_FLAG_F, 1,error)
!!$ CHECK_I(ret, "H5Pset_shared_mesg_index");
ENDIF
@@ -2588,11 +2166,6 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
! /* Close file */
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
-!!$
-!!$ /* Get size of file */
-!!$ empty_filesize = h5_get_file_size(FILENAME);
-!!$ if(empty_filesize < 0)
-!!$ TestErrPrintf("Line %d: file size wrong!\n", __LINE__);
! /* Re-open file */
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl)
@@ -2930,7 +2503,7 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error)
data_dims = 0
! /* Output message about test being performed */
- WRITE(*,*) " - Testing Opening Attributes in Dense Storage"
+! WRITE(*,*) " - Testing Opening Attributes in Dense Storage"
! /* Create file */
@@ -2942,10 +2515,6 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error)
CALL check("h5fclose_f",error,total_error)
- ! /* Get size of file */
-!!$ empty_filesize = h5_get_file_size(FILENAME);
-!!$ if(empty_filesize < 0)
-!!$ TestErrPrintf("Line %d: file size wrong!\n", __LINE__);
! /* Re-open file */
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl)
@@ -3124,8 +2693,6 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
DO u=0, max_attr-1
-! size_t name_len; /* Length of attribute name */
-! char check_name[ATTR_NAME_LEN]; /* Buffer for checking attribute names */
! /* Open attribute */
@@ -3188,7 +2755,7 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
INTEGER :: minusone = -1
! /* Output message about test being performed */
- WRITE(*,*) " - Testing Basic Code for Attributes with Creation Order Info"
+! WRITE(*,*) " - Testing Basic Code for Attributes with Creation Order Info"
! /* Create file */
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
@@ -3232,11 +2799,6 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f",error,total_error)
- ! /* Check on dataset's attribute storage status */
-!!$ is_empty = H5O_is_attr_empty_test(dataset);
-!!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test");
-!!$ is_dense = H5O_is_attr_dense_test(dataset);
-!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test");
! /* Close Dataset */
CALL h5dclose_f(dataset, error)
@@ -3258,11 +2820,6 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
CALL h5dopen_f(fid, DSET1_NAME, dataset, error, H5P_DEFAULT_F )
CALL check("h5dopen_f",error,total_error)
- ! /* Check on dataset's attribute storage status */
-!!$ is_empty = H5O_is_attr_empty_test(dataset);
-!!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test");
-!!$ is_dense = H5O_is_attr_dense_test(dataset);
-!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test");
! /* Retrieve dataset creation property list for group */
CALL H5Dget_create_plist_f(dataset, dcpl, error)
@@ -3350,7 +2907,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
attr_data1a(3) = -99890
! /* Output message about test being performed */
- WRITE(*,*) " - Testing Basic Scalar Attribute Writing Functions"
+! WRITE(*,*) " - Testing Basic Scalar Attribute Writing Functions"
! /* Create file */
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid1, error, H5P_DEFAULT_F, fapl)
@@ -3535,7 +3092,7 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
data_dims = 0
! /* Output message about test being performed */
- WRITE(*,*) " - Testing Storing Many Attributes"
+! WRITE(*,*) " - Testing Storing Many Attributes"
!/* Create file */
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
@@ -3602,54 +3159,7 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
-!!$ /* Re-open the file and check on the attributes */
-!!$
-!!$ /* Re-open file */
-!!$ fid = H5Fopen(FILENAME, H5F_ACC_RDONLY, fapl);
-!!$ CHECK(fid, FAIL, "H5Fopen");
-!!$
-!!$ /* Re-open group */
-!!$ gid = H5Gopen2(fid, GROUP1_NAME, H5P_DEFAULT);
-!!$ CHECK(gid, FAIL, "H5Gopen2");
-!!$
-!!$ /* Verify attributes */
-!!$ for(u = 0; u < nattr; u++) {
-!!$ unsigned value; /* Attribute value */
-!!$
-!!$ sprintf(attrname, "a-%06u", u);
-!!$
-!!$ exists = H5Aexists(gid, attrname);
-!!$ VERIFY(exists, TRUE, "H5Aexists");
-!!$
-!!$ exists = H5Aexists_by_name(fid, GROUP1_NAME, attrname, H5P_DEFAULT);
-!!$ VERIFY(exists, TRUE, "H5Aexists_by_name");
-!!$
-!!$ aid = H5Aopen(gid, attrname, H5P_DEFAULT);
-!!$ CHECK(aid, FAIL, "H5Aopen");
-!!$
-!!$ exists = H5Aexists(gid, attrname);
-!!$ VERIFY(exists, TRUE, "H5Aexists");
-!!$
-!!$ exists = H5Aexists_by_name(fid, GROUP1_NAME, attrname, H5P_DEFAULT);
-!!$ VERIFY(exists, TRUE, "H5Aexists_by_name");
-!!$
-!!$ ret = H5Aread(aid, H5T_NATIVE_UINT, &value);
-!!$ CHECK(ret, FAIL, "H5Aread");
-!!$ VERIFY(value, u, "H5Aread");
-!!$
-!!$ ret = H5Aclose(aid);
-!!$ CHECK(ret, FAIL, "H5Aclose");
-!!$ } /* end for */
-!!$
- ! /* Close group */
-!!$ CALL H5Gclose_f(gid, error)
-!!$ CALL check("h5gclose_f",error,total_error)
-
- ! /* Close file */
-!!$ CALL h5fclose_f(fid, error)
-!!$ CALL check("h5fclose_f",error,total_error)
-
-! /* Close dataspaces */
+ ! /* Close dataspaces */
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f",error,total_error)
@@ -3663,8 +3173,8 @@ END SUBROUTINE test_attr_many
! * Return: Success: 0
! * Failure: -1
! *
-! * Programmer: Quincey Koziol
-! * Wednesday, February 21, 2007
+! * Programmer: Fortran version (M.S. Breitenfeld)
+! * March 21, 2008
! *
! *-------------------------------------------------------------------------
! */
diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90
index cc1ab67..4639731 100644
--- a/fortran/test/tH5G_1_8.f90
+++ b/fortran/test/tH5G_1_8.f90
@@ -24,7 +24,7 @@ SUBROUTINE group_test(cleanup, total_error)
INTEGER :: error
- WRITE(*,*) "TESTING GROUPS"
+! WRITE(*,*) "TESTING GROUPS"
CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error)
CALL check("H5Pcreate_f",error, total_error)
@@ -137,48 +137,48 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
IF(idx_type == H5_INDEX_CRT_ORDER_F)THEN
IF(iorder == H5_ITER_INC_F)THEN
order = H5_ITER_INC_F
- IF(use_index(i))THEN
- WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/creation order index"
- ELSE
- WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/o creation order index"
- ENDIF
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/creation order index"
+!!$ ELSE
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/o creation order index"
+!!$ ENDIF
ELSE IF (iorder == H5_ITER_DEC_F) THEN
order = H5_ITER_DEC_F
- IF(use_index(i))THEN
- WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/creation order index"
- ELSE
- WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/o creation order index"
- ENDIF
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/creation order index"
+!!$ ELSE
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/o creation order index"
+!!$ ENDIF
ELSE
order = H5_ITER_NATIVE_F
- IF(use_index(i))THEN
- WRITE(*,'(5x,A)')"query group info by creation order index in native order w/creation order index"
- ELSE
- WRITE(*,'(5x,A)')"query group info by creation order index in native order w/o creation order index"
- ENDIF
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in native order w/creation order index"
+!!$ ELSE
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in native order w/o creation order index"
+!!$ ENDIF
ENDIF
ELSE
IF(iorder == H5_ITER_INC_F)THEN
order = H5_ITER_INC_F
- IF(use_index(i))THEN
- WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/creation order index"
- ELSE
- WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/o creation order index"
- ENDIF
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/creation order index"
+!!$ ELSE
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/o creation order index"
+!!$ ENDIF
ELSE IF (iorder == H5_ITER_DEC_F) THEN
order = H5_ITER_DEC_F
- IF(use_index(i))THEN
- WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/creation order index"
- ELSE
- WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/o creation order index"
- ENDIF
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/creation order index"
+!!$ ELSE
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/o creation order index"
+!!$ ENDIF
ELSE
order = H5_ITER_NATIVE_F
- IF(use_index(i))THEN
- WRITE(*,'(5x,A)')"query group info by creation order index in native order w/creation order index"
- ELSE
- WRITE(*,'(5x,A)')"query group info by creation order index in native order w/o creation order index"
- ENDIF
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in native order w/creation order index"
+!!$ ELSE
+!!$ WRITE(*,'(5x,A)')"query group info by creation order index in native order w/o creation order index"
+!!$ ENDIF
ENDIF
END IF
@@ -351,156 +351,6 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error)
ENDDO
- ! /* Verify state of group (compact) */
- ! if(H5G_has_links_test(group_id, NULL) != TRUE) TEST_ERROR
-
- !/* Check for out of bound query by index */
- ! H5E_BEGIN_TRY {
- ! ret = H5Gget_info_by_idx(group_id, ".", H5_INDEX_NAME, order, (hsize_t)u, &grp_info, H5P_DEFAULT);
- ! } H5E_END_TRY;
- ! if(ret >= 0) TEST_ERROR
-
- ! /* Create more links, to push group into dense form */
-!!$ for(; u < (max_compact * 2); u++) {
-!!$ hid_t group_id2, group_id3; /* Group IDs */
-!!$
-!!$ /* Make name for link */
-!!$ sprintf(objname, "filler %02u", u);
-!!$
-!!$ /* Create hard link, with group object */
-!!$ if((group_id2 = H5Gcreate2(group_id, objname, H5P_DEFAULT, gcpl_id, H5P_DEFAULT)) < 0) TEST_ERROR
-!!$
-!!$
-!!$ /* Retrieve group's information */
-!!$ if(H5Gget_info(group_id2, &grp_info) < 0) TEST_ERROR
-!!$
-!!$ /* Check (new/empty) group's information */
-!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_COMPACT) TEST_ERROR
-!!$ if(grp_info.max_corder != 0) TEST_ERROR
-!!$ if(grp_info.nlinks != 0) TEST_ERROR
-!!$
-!!$ /* Retrieve group's information, by name */
-!!$ if(H5Gget_info_by_name(group_id, objname, &grp_info, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Check (new/empty) group's information */
-!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_COMPACT) TEST_ERROR
-!!$ if(grp_info.max_corder != 0) TEST_ERROR
-!!$ if(grp_info.nlinks != 0) TEST_ERROR
-!!$
-!!$ /* Retrieve group's information, by name */
-!!$ if(H5Gget_info_by_name(group_id2, ".", &grp_info, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Check (new/empty) group's information */
-!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_COMPACT) TEST_ERROR
-!!$ if(grp_info.max_corder != 0) TEST_ERROR
-!!$ if(grp_info.nlinks != 0) TEST_ERROR
-!!$
-!!$
-!!$ /* Create objects in new group created */
-!!$ for(v = 0; v <= u; v++) {
-!!$ /* Make name for link */
-!!$ sprintf(objname2, "filler %02u", v);
-!!$
-!!$ /* Create hard link, with group object */
-!!$ if((group_id3 = H5Gcreate2(group_id2, objname2, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR
-!!$
-!!$ /* Close group created */
-!!$ if(H5Gclose(group_id3) < 0) TEST_ERROR
-!!$ } /* end for */
-!!$
-!!$
-!!$ /* Retrieve group's information */
-!!$ if(H5Gget_info(group_id2, &grp_info) < 0) TEST_ERROR
-!!$
-!!$ /* Check (new) group's information */
-!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR
-!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR
-!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR
-!!$
-!!$ /* Retrieve group's information, by name */
-!!$ if(H5Gget_info_by_name(group_id, objname, &grp_info, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Check (new) group's information */
-!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR
-!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR
-!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR
-!!$
-!!$ /* Retrieve group's information, by name */
-!!$ if(H5Gget_info_by_name(group_id2, ".", &grp_info, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Check (new) group's information */
-!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR
-!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR
-!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR
-!!$
-!!$
-!!$ /* Retrieve group's information */
-!!$ if(order != H5_ITER_NATIVE) {
-!!$ if(order == H5_ITER_INC) {
-!!$ if(H5Gget_info_by_idx(group_id, ".", idx_type, order, (hsize_t)u, &grp_info, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ } /* end if */
-!!$ else {
-!!$ if(H5Gget_info_by_idx(group_id, ".", idx_type, order, (hsize_t)0, &grp_info, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ } /* end else */
-!!$
-!!$ /* Check (new) group's information */
-!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR
-!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR
-!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR
-!!$ } /* end if */
-!!$
-!!$ /* Close group created */
-!!$ if(H5Gclose(group_id2) < 0) TEST_ERROR
-!!$
-!!$
-!!$ /* Retrieve main group's information */
-!!$ if(H5Gget_info(group_id, &grp_info) < 0) TEST_ERROR
-!!$
-!!$ /* Check main group's information */
-!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR
-!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR
-!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR
-!!$
-!!$ /* Retrieve main group's information, by name */
-!!$ if(H5Gget_info_by_name(file_id, CORDER_GROUP_NAME, &grp_info, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Check main group's information */
-!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR
-!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR
-!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR
-!!$
-!!$ /* Retrieve main group's information, by name */
-!!$ if(H5Gget_info_by_name(group_id, ".", &grp_info, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Check main group's information */
-!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR
-!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR
-!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR
-!!$
-!!$
-!!$ /* Create soft link in another group, to objects in main group */
-!!$ sprintf(valname, "/%s/%s", CORDER_GROUP_NAME, objname);
-!!$ if(H5Lcreate_soft(valname, soft_group_id, objname, H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Retrieve soft link group's information, by name */
-!!$ if(H5Gget_info(soft_group_id, &grp_info) < 0) TEST_ERROR
-!!$
-!!$ /* Check soft link group's information */
-!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR
-!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR
-!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR
-!!$ } /* end for */
-!!$
-!!$ /* Verify state of group (dense) */
-!!$ if(H5G_is_new_dense_test(group_id) != TRUE) TEST_ERROR
-!!$
-!!$ /* Check for out of bound query by index */
-!!$ H5E_BEGIN_TRY {
-!!$ ret = H5Gget_info_by_idx(group_id, ".", H5_INDEX_NAME, order, (hsize_t)u, &grp_info, H5P_DEFAULT);
-!!$ } H5E_END_TRY;
-!!$ if(ret >= 0) TEST_ERROR
-
-
! /* Close the groups */
CALL H5Gclose_f(group_id, error)
@@ -563,7 +413,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
INTEGER :: error
! /* Print test message */
- WRITE(*,*) "timestamps on objects"
+! WRITE(*,*) "timestamps on objects"
! /* Create group creation property list */
CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, error )
@@ -749,7 +599,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
INTEGER :: arank = 1 ! Attribure rank
INTEGER :: error
- WRITE(*,*) "link creation (w/new group format)"
+! WRITE(*,*) "link creation (w/new group format)"
! /* Create a file */
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, file, error, H5P_DEFAULT_F, fapl)
@@ -846,7 +696,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
INTEGER :: error
- WRITE(*,*) "moving and copying links preserves their properties (w/new group format)"
+! WRITE(*,*) "moving and copying links preserves their properties (w/new group format)"
!/* Create a file creation property list with creation order stored for links
! * in the root group
@@ -997,165 +847,6 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
END SUBROUTINE test_move_preserves
-!!$!/*-------------------------------------------------------------------------
-!!$! * Function: ud_hard_links
-!!$! *
-!!$! * Purpose: Check that the functionality of hard links can be duplicated
-!!$! * with user-defined links.
-!!$! *
-!!$! *
-!!$! * Programmer: M.S. Breitenfeld
-!!$! * February, 2008
-!!$! *
-!!$! *-------------------------------------------------------------------------
-!!$! */
-!!$!
-!!$!/* Callback functions for UD hard links. */
-!!$!/* UD_hard_create increments the object's reference count */
-!!$
-!!$ SUBROUTINE ud_hard_links(fapl, total_error)
-!!$
-!!$ USE HDF5 ! This module contains all necessary modules
-!!$
-!!$ IMPLICIT NONE
-!!$ INTEGER, INTENT(OUT) :: total_error
-!!$ INTEGER(HID_T), INTENT(IN) :: fapl
-!!$
-!!$ INTEGER(HID_T) :: fid ! /* File ID */
-!!$ INTEGER(HID_T) :: gid ! /* Group IDs */
-!!$
-!!$ CHARACTER(LEN=10) :: objname = 'objname.h5' ! /* Object name */
-!!$ CHARACTER(LEN=10), PARAMETER :: filename = 'filname.h5'
-!!$
-!!$ INTEGER(HSIZE_T) :: name_len ! /* Size of an empty file */
-!!$
-!!$ INTEGER, PARAMETER :: UD_HARD_TYPE=201
-!!$ LOGICAL :: registered
-!!$
-!!$!/* Link information */
-!!$
-!!$! ssize_t name_len; /* Length of object name */
-!!$! h5_stat_size_t empty_size; /* Size of an empty file */
-!!$
-!!$
-!!$ WRITE(*,*) "user-defined hard link (w/new group format)"
-!!$
-!!$ ! /* Set up filename and create file*/
-!!$
-!!$ CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, H5P_DEFAULT_F, fapl)
-!!$ CALL check("h5fcreate_f",error,total_error)
-!!$
-!!$ ! /* Close file */
-!!$ CALL h5fclose_f(fid, error)
-!!$ CALL check("h5fclose_f",error,total_error)
-!!$
-!!$ ! if((empty_size = h5_get_file_size(filename))<0) TEST_ERROR
-!!$
-!!$ ! /* Create file */
-!!$ CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, H5P_DEFAULT_F, fapl)
-!!$ CALL check("h5fcreate_f",error,total_error)
-!!$
-!!$ ! /* Check that external links are registered and UD hard links are not */
-!!$
-!!$ CALL H5Lis_registered(H5L_TYPE_EXTERNAL, registered, error)
-!!$ CALL VerifyLogical("H5Lis_registered", registered, .TRUE., total_error)
-!!$
-!!$ CALL H5Lis_registered(UD_HARD_TYPE, registered, error)
-!!$ CALL VerifyLogical("H5Lis_registered", registered, .FALSE., total_error)
-!!$
-!!$ !/* Register "user-defined hard links" with the library */
-!!$! if(H5Lregister(UD_hard_class) < 0) TEST_ERROR
-!!$
-!!$ /* Check that UD hard links are now registered */
-!!$ if(H5Lis_registered(H5L_TYPE_EXTERNAL) != TRUE) TEST_ERROR
-!!$ if(H5Lis_registered(UD_HARD_TYPE) != TRUE) TEST_ERROR
-!!$
-!!$ /* Create a group for the UD hard link to point to */
-!!$ if((gid = H5Gcreate2(fid, "group", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR
-!!$
-!!$ /* Get address for the group to give to the hard link */
-!!$ if(H5Lget_info(fid, "group", &li, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ if(H5Gclose(gid) < 0) TEST_ERROR
-!!$
-!!$
-!!$ /* Create a user-defined "hard link" to the group using the address we got
-!!$ * from H5Lget_info */
-!!$ if(H5Lcreate_ud(fid, "ud_link", UD_HARD_TYPE, &(li.u.address), sizeof(haddr_t), H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Close and re-open file to ensure that data is written to disk */
-!!$ if(H5Fclose(fid) < 0) TEST_ERROR
-!!$ if((fid = H5Fopen(filename, H5F_ACC_RDWR, H5P_DEFAULT)) < 0) TEST_ERROR
-!!$
-!!$ /* Open group through UD link */
-!!$ if((gid = H5Gopen2(fid, "ud_link", H5P_DEFAULT)) < 0) FAIL_STACK_ERROR
-!!$
-!!$ /* Check name */
-!!$ if((name_len = H5Iget_name( gid, objname, (size_t)NAME_BUF_SIZE )) < 0) TEST_ERROR
-!!$ if(HDstrcmp(objname, "/group")) TEST_ERROR
-!!$
-!!$ /* Create object in group */
-!!$ if((gid2 = H5Gcreate2(gid, "new_group", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR
-!!$
-!!$ /* Close groups*/
-!!$ if(H5Gclose(gid2) < 0) TEST_ERROR
-!!$ if(H5Gclose(gid) < 0) TEST_ERROR
-!!$
-!!$ /* Re-open group without using ud link to check that it was created properly */
-!!$ if((gid = H5Gopen2(fid, "group/new_group", H5P_DEFAULT)) < 0) FAIL_STACK_ERROR
-!!$
-!!$ /* Check name */
-!!$ if((name_len = H5Iget_name( gid, objname, (size_t)NAME_BUF_SIZE )) < 0) TEST_ERROR
-!!$ if(HDstrcmp(objname, "/group/new_group")) TEST_ERROR
-!!$
-!!$ /* Close opened object */
-!!$ if(H5Gclose(gid) < 0) FAIL_STACK_ERROR
-!!$
-!!$ /* Check that H5Lget_objinfo works on the hard link */
-!!$ if(H5Lget_info(fid, "ud_link", &li, H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$ /* UD hard links have no query function, thus return a "link length" of 0 */
-!!$ if(li.u.val_size != 0) TEST_ERROR
-!!$ if(UD_HARD_TYPE != li.type) {
-!!$ H5_FAILED();
-!!$ puts(" Unexpected link class - should have been a UD hard link");
-!!$ goto error;
-!!$ } /* end if */
-!!$
-!!$ /* Unlink the group pointed to by the UD link. It shouldn't be
-!!$ * deleted because of the UD link. */
-!!$ if(H5Ldelete(fid, "/group", H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$
-!!$ /* Ensure we can open the group through the UD link */
-!!$ if((gid = H5Gopen2(fid, "ud_link", H5P_DEFAULT)) < 0) FAIL_STACK_ERROR
-!!$
-!!$ /* Unlink the group contained within it. */
-!!$ if(H5Ldelete(gid, "new_group", H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$ if(H5Gclose(gid) < 0) FAIL_STACK_ERROR
-!!$
-!!$ /* Now delete the UD link. This should cause the group to be
-!!$ * deleted, too. */
-!!$ if(H5Ldelete(fid, "ud_link", H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$
-!!$ /* Close file */
-!!$ if(H5Fclose(fid) < 0) FAIL_STACK_ERROR
-!!$
-!!$ /* The file should be empty again. */
-!!$ if(empty_size != h5_get_file_size(filename)) TEST_ERROR
-!!$
-!!$ if(H5Lunregister(UD_HARD_TYPE) < 0) FAIL_STACK_ERROR
-!!$
-!!$ PASSED();
-!!$ return 0;
-!!$
-!!$ error:
-!!$ H5E_BEGIN_TRY {
-!!$ H5Gclose(gid2);
-!!$ H5Gclose(gid);
-!!$ H5Fclose(fid);
-!!$ } H5E_END_TRY;
-!!$ return -1;
-!!$} /* end ud_hard_links() */
-
!/*-------------------------------------------------------------------------
! * Function: lifecycle
! *
@@ -1211,7 +902,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
INTEGER :: H5G_CRT_GINFO_EST_NAME_LEN = 8
logical :: cleanup
- WRITE(*,*) 'group lifecycle'
+! WRITE(*,*) 'group lifecycle'
! /* Create file */
CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl2)
@@ -1283,105 +974,6 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
CALL verify("H5Pget_est_link_info_f", est_name_len, LIFECYCLE_EST_NAME_LEN,total_error)
- ! /* Use internal testing routine to check that the group has no links or symbol table */
- ! if(H5G_is_empty_test(gid) != TRUE) TEST_ERROR
-
-!!$ /* Create first "bottom" group */
-!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, (unsigned)0);
-!!$ IF((gid2 = H5Gcreate2(gid, objname, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR
-!!$
-!!$ /* Check on bottom group's status */
-!!$ if(H5G_is_empty_test(gid2) != TRUE) TEST_ERROR
-!!$
-!!$ /* Close bottom group */
-!!$ if(H5Gclose(gid2) < 0) TEST_ERROR
-!!$
-!!$ /* Check on top group's status */
-!!$ if(H5G_is_empty_test(gid) == TRUE) TEST_ERROR
-!!$ if(H5G_has_links_test(gid, &nmsgs) != TRUE) TEST_ERROR
-!!$ if(nmsgs != 1) TEST_ERROR
-!!$
-!!$ /* Create several more bottom groups, to push the top group almost to a symbol table */
-!!$ /* (Start counting at '1', since we've already created one bottom group */
-!!$ for(u = 1; u < LIFECYCLE_MAX_COMPACT; u++) {
-!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u);
-!!$ if((gid2 = H5Gcreate2(gid, objname, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR
-!!$
-!!$ /* Check on bottom group's status */
-!!$ if(H5G_is_empty_test(gid2) != TRUE) TEST_ERROR
-!!$
-!!$ /* Close bottom group */
-!!$ if(H5Gclose(gid2) < 0) TEST_ERROR
-!!$ } /* end for */
-!!$
-!!$ /* Check on top group's status */
-!!$ if(H5G_is_empty_test(gid) == TRUE) TEST_ERROR
-!!$ if(H5G_has_links_test(gid, &nmsgs) != TRUE) TEST_ERROR
-!!$ if(nmsgs != LIFECYCLE_MAX_COMPACT) TEST_ERROR
-!!$ if(H5G_is_new_dense_test(gid) != FALSE) TEST_ERROR
-!!$
-!!$ /* Check that the object header is only one chunk and the space has been allocated correctly */
-!!$ if(H5Oget_info(gid, &oinfo) < 0) TEST_ERROR
-!!$ if(oinfo.hdr.space.total != 151) TEST_ERROR
-!!$ if(oinfo.hdr.space.free != 0) TEST_ERROR
-!!$ if(oinfo.hdr.nmesgs != 6) TEST_ERROR
-!!$ if(oinfo.hdr.nchunks != 1) TEST_ERROR
-!!$
-!!$ /* Create one more "bottom" group, which should push top group into using a symbol table */
-!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u);
-!!$ if((gid2 = H5Gcreate2(gid, objname, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR
-!!$
-!!$ /* Check on bottom group's status */
-!!$ if(H5G_is_empty_test(gid2) != TRUE) TEST_ERROR
-!!$
-!!$ /* Close bottom group */
-!!$ if(H5Gclose(gid2) < 0) TEST_ERROR
-!!$
-!!$ /* Check on top group's status */
-!!$ if(H5G_is_empty_test(gid) == TRUE) TEST_ERROR
-!!$ if(H5G_has_links_test(gid, NULL) == TRUE) TEST_ERROR
-!!$ if(H5G_is_new_dense_test(gid) != TRUE) TEST_ERROR
-!!$
-!!$ /* Check that the object header is still one chunk and the space has been allocated correctly */
-!!$ if(H5Oget_info(gid, &oinfo) < 0) TEST_ERROR
-!!$ if(oinfo.hdr.space.total != 151) TEST_ERROR
-!!$ if(oinfo.hdr.space.free != 92) TEST_ERROR
-!!$ if(oinfo.hdr.nmesgs != 3) TEST_ERROR
-!!$ if(oinfo.hdr.nchunks != 1) TEST_ERROR
-!!$
-!!$ /* Unlink objects from top group */
-!!$ while(u >= LIFECYCLE_MIN_DENSE) {
-!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u);
-!!$
-!!$ if(H5Ldelete(gid, objname, H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$
-!!$ u--;
-!!$ } /* end while */
-!!$
-!!$ /* Check on top group's status */
-!!$ if(H5G_is_empty_test(gid) == TRUE) TEST_ERROR
-!!$ if(H5G_has_links_test(gid, NULL) == TRUE) TEST_ERROR
-!!$ if(H5G_is_new_dense_test(gid) != TRUE) TEST_ERROR
-!!$
-!!$ /* Unlink one more object from the group, which should transform back to using links */
-!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u);
-!!$ if(H5Ldelete(gid, objname, H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$ u--;
-!!$
-!!$ /* Check on top group's status */
-!!$ if(H5G_is_empty_test(gid) == TRUE) TEST_ERROR
-!!$ if(H5G_has_links_test(gid, &nmsgs) != TRUE) TEST_ERROR
-!!$ if(nmsgs != (LIFECYCLE_MIN_DENSE - 1)) TEST_ERROR
-!!$
-!!$ /* Unlink last two objects from top group */
-!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u);
-!!$ if(H5Ldelete(gid, objname, H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$ u--;
-!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u);
-!!$ if(H5Ldelete(gid, objname, H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$
-!!$ /* Check on top group's status */
-!!$ if(H5G_is_empty_test(gid) != TRUE) TEST_ERROR
!/* Close top group */
CALL H5Gclose_f(gid, error)
@@ -1400,12 +992,6 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
CALL H5Fclose_f(fid,error)
CALL check("H5Fclose_f",error,total_error)
-!!$ /* Get size of file as empty */
-!!$ if((file_size = h5_get_file_size(filename)) < 0) TEST_ERROR
-!!$
-!!$ /* Verify that file is correct size */
-!!$ if(file_size != empty_size) TEST_ERROR
-
IF(cleanup) CALL h5_cleanup_f("fixx", H5P_DEFAULT_F, error)
CALL check("h5_cleanup_f", error, total_error)
@@ -1450,12 +1036,6 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
LOGICAL :: Lexists
-
-!!$ if(new_format)
-!!$ TESTING("link queries (w/new group format)")
-!!$ else
-!!$ TESTING("link queries")
-
! /* Open the file */
CALL H5Fopen_f(filename, H5F_ACC_RDONLY_F, file, error,access_prp=fapl)
CALL check("H5Fopen_f",error,total_error)
@@ -1483,93 +1063,11 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
CALL H5Lexists_f(file,"grp1/hard",Lexists, error)
CALL verifylogical("test_lcpl.H5Lexists", Lexists,.TRUE.,total_error)
-
-!!$ /* Symbolic link */
-!!$ if(H5Oget_info_by_name(file, "grp1/soft", &oinfo2, H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$ if(H5O_TYPE_DATASET != oinfo2.type) {
-!!$ H5_FAILED();
-!!$ printf(" %d: Unexpected object type should have been a dataset\n", __LINE__);
-!!$ TEST_ERROR
-!!$ } /* end if */
-!!$ if(H5F_addr_ne(oinfo1.addr, oinfo2.addr)) {
-!!$ H5_FAILED();
-!!$ puts(" Soft link test failed. Link seems not to point to the ");
-!!$ puts(" expected file location.");
-!!$ TEST_ERROR
-!!$ } /* end if */
-
-! CALL H5Lget_val(file, "grp1/soft", INT(LEN(linkval), SIZE_T), linkval, error)
-
-
-!!$ if(H5Lget_val(file, "grp1/soft", linkval, sizeof linkval, H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$ if(HDstrcmp(linkval, "/d1")) {
-!!$ H5_FAILED();
-!!$ puts(" Soft link test failed. Wrong link value");
-!!$ TEST_ERROR
-!!$ } /* end if */
-!!$ if(H5Lexists(file, "grp1/soft", H5P_DEFAULT) != TRUE) FAIL_STACK_ERROR
-!!$
-!!$ /* Dangling link */
-!!$ H5E_BEGIN_TRY {
-!!$ status = H5Oget_info_by_name(file, "grp1/dangle", &oinfo2, H5P_DEFAULT);
-!!$ } H5E_END_TRY;
-!!$ if(status >= 0) {
-!!$ H5_FAILED();
-!!$ puts(" H5Oget_info_by_name() should have failed for a dangling link.");
-!!$ TEST_ERROR
-!!$ } /* end if */
-!!$ if(H5Lget_info(file, "grp1/dangle", &linfo2, H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$ if(H5L_TYPE_SOFT != linfo2.type) {
-!!$ H5_FAILED();
-!!$ printf(" %d: Unexpected object type should have been a symbolic link\n", __LINE__);
-!!$ TEST_ERROR
-!!$ } /* end if */
-!!$ if(H5Lget_val(file, "grp1/dangle", linkval, sizeof linkval, H5P_DEFAULT) < 0) {
-!!$ H5_FAILED();
-!!$ printf(" %d: Can't retrieve link value\n", __LINE__);
-!!$ TEST_ERROR
-!!$ } /* end if */
-!!$ if(HDstrcmp(linkval, "foobar")) {
-!!$ H5_FAILED();
-!!$ puts(" Dangling link test failed. Wrong link value");
-!!$ TEST_ERROR
-!!$ } /* end if */
-!!$ if(H5Lexists(file, "grp1/dangle", H5P_DEFAULT) != TRUE) FAIL_STACK_ERROR
-!!$
-!!$ /* Recursive link */
-!!$ H5E_BEGIN_TRY {
-!!$ status = H5Oget_info_by_name(file, "grp1/recursive", &oinfo2, H5P_DEFAULT);
-!!$ } H5E_END_TRY;
-!!$ if(status >= 0) {
-!!$ H5_FAILED();
-!!$ puts(" H5Oget_info_by_name() should have failed for a recursive link.");
-!!$ TEST_ERROR
-!!$ } /* end if */
-!!$ if(H5Lget_info(file, "grp1/recursive", &linfo2, H5P_DEFAULT) < 0) FAIL_STACK_ERROR
-!!$ if(H5L_TYPE_SOFT != linfo2.type) {
-!!$ H5_FAILED();
-!!$ printf(" %d: Unexpected object type should have been a symbolic link\n", __LINE__);
-!!$ TEST_ERROR
-!!$ } /* end if */
-!!$ if(H5Lget_val(file, "grp1/recursive", linkval, sizeof linkval, H5P_DEFAULT) < 0) {
-!!$ H5_FAILED();
-!!$ printf(" %d: Can't retrieve link value\n", __LINE__);
-!!$ TEST_ERROR
-!!$ } /* end if */
-!!$ if(HDstrcmp(linkval, "/grp1/recursive")) {
-!!$ H5_FAILED();
-!!$ puts(" Recursive link test failed. Wrong link value");
-!!$ TEST_ERROR
-!!$ } /* end if */
-!!$
-!!$ /* Non-existant link */
-!!$ if(H5Lexists(file, "foobar", H5P_DEFAULT) == TRUE) FAIL_STACK_ERROR
-
! /* Cleanup */
- CALL H5Fclose_f(file,error)
- CALL check("H5Fclose_f",error,total_error)
+ CALL H5Fclose_f(file,error)
+ CALL check("H5Fclose_f",error,total_error)
- END SUBROUTINE cklinks
+END SUBROUTINE cklinks
!/*-------------------------------------------------------------------------
@@ -1647,37 +1145,35 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
! /* Loop over using index for creation order value */
DO i = 1, 2
! /* Print appropriate test message */
- IF(idx_type == H5_INDEX_CRT_ORDER_F)THEN
- IF(iorder == H5_ITER_INC_F)THEN
- IF(use_index(i))THEN
- WRITE(*,'(5x,A)')"deleting links by creation order index in increasing order w/creation order index"
- ELSE
- WRITE(*,'(5x,A)')"deleting links by creation order index in increasing order w/o creation order index"
- ENDIF
- ELSE
- IF(use_index(i))THEN
- WRITE(*,'(5x,A)')"deleting links by creation order index in decreasing order w/creation order index"
- ELSE
- WRITE(*,'(5x,A)')"deleting links by creation order index in decreasing order w/o creation order index"
- ENDIF
- ENDIF
- ELSE
- IF(iorder == H5_ITER_INC_F)THEN
- IF(use_index(i))THEN
- WRITE(*,'(5x,A)')"deleting links by name index in increasing order w/creation order index"
- ELSE
- WRITE(*,'(5x,A)')"deleting links by name index in increasing order w/o creation order index"
- ENDIF
- ELSE
- IF(use_index(i))THEN
- WRITE(*,'(5x,A)')"deleting links by name index in decreasing order w/creation order index"
- ELSE
- WRITE(*,'(5x,A)')"deleting links by name index in decreasing order w/o creation order index"
- ENDIF
- ENDIF
- ENDIF
-! CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error)
-! IF(error .NE. 0) STOP
+!!$ IF(idx_type == H5_INDEX_CRT_ORDER_F)THEN
+!!$ IF(iorder == H5_ITER_INC_F)THEN
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(5x,A)')"deleting links by creation order index in increasing order w/creation order index"
+!!$ ELSE
+!!$ WRITE(*,'(5x,A)')"deleting links by creation order index in increasing order w/o creation order index"
+!!$ ENDIF
+!!$ ELSE
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(5x,A)')"deleting links by creation order index in decreasing order w/creation order index"
+!!$ ELSE
+!!$ WRITE(*,'(5x,A)')"deleting links by creation order index in decreasing order w/o creation order index"
+!!$ ENDIF
+!!$ ENDIF
+!!$ ELSE
+!!$ IF(iorder == H5_ITER_INC_F)THEN
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(5x,A)')"deleting links by name index in increasing order w/creation order index"
+!!$ ELSE
+!!$ WRITE(*,'(5x,A)')"deleting links by name index in increasing order w/o creation order index"
+!!$ ENDIF
+!!$ ELSE
+!!$ IF(use_index(i))THEN
+!!$ WRITE(*,'(5x,A)')"deleting links by name index in decreasing order w/creation order index"
+!!$ ELSE
+!!$ WRITE(*,'(5x,A)')"deleting links by name index in decreasing order w/o creation order index"
+!!$ ENDIF
+!!$ ENDIF
+!!$ ENDIF
! /* Create file */
CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, access_prp=fapl)
@@ -1771,158 +1267,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
!!$ PRINT*,objname, tmpname
!!$ CALL verifyString("delete_by_idx.H5Lget_name_by_idx_f", objname, tmpname, total_error)
ENDDO
-!!$
-!!$ /* Delete last link */
-!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Verify state of group (empty) */
-!!$ if(H5G_has_links_test(group_id, NULL) == TRUE) TEST_ERROR
-!!$
-!!$ /* Create more links, to push group into dense form */
-!!$ for(u = 0; u < (max_compact * 2); u++) {
-!!$ hid_t group_id2; /* Group ID */
-!!$
-!!$ /* Make name for link */
-!!$ sprintf(objname, "filler %02u", u);
-!!$
-!!$ /* Create hard link, with group object */
-!!$ if((group_id2 = H5Gcreate2(group_id, objname, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR
-!!$ if(H5Gclose(group_id2) < 0) TEST_ERROR
-!!$
-!!$ /* Verify state of group (dense) */
-!!$ if(u >= max_compact)
-!!$ if(H5G_is_new_dense_test(group_id) != TRUE) TEST_ERROR
-!!$
-!!$ /* Verify link information for new link */
-!!$ if(link_info_by_idx_check(group_id, objname, (hsize_t)u, TRUE, use_index) < 0) TEST_ERROR
-!!$ } /* end for */
-!!$
-!!$ /* Check for out of bound deletion again */
-!!$ H5E_BEGIN_TRY {
-!!$ ret = H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)u, H5P_DEFAULT);
-!!$ } H5E_END_TRY;
-!!$ if(ret >= 0) TEST_ERROR
-!!$
-!!$ /* Delete links from dense group, in appropriate order */
-!!$ for(u = 0; u < ((max_compact * 2) - 1); u++) {
-!!$ /* Delete first link in appropriate order */
-!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Verify the link information for first link in appropriate order */
-!!$ HDmemset(&linfo, 0, sizeof(linfo));
-!!$ if(H5Lget_info_by_idx(group_id, ".", idx_type, order, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(order == H5_ITER_INC) {
-!!$ if(linfo.corder != (u + 1)) TEST_ERROR
-!!$ } /* end if */
-!!$ else {
-!!$ if(linfo.corder != ((max_compact * 2) - (u + 2))) TEST_ERROR
-!!$ } /* end else */
-!!$
-!!$ /* Verify the name for first link in appropriate order */
-!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
-!!$ if(H5Lget_name_by_idx(group_id, ".", idx_type, order, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(order == H5_ITER_INC)
-!!$ sprintf(objname, "filler %02u", (u + 1));
-!!$ else
-!!$ sprintf(objname, "filler %02u", ((max_compact * 2) - (u + 2)));
-!!$ if(HDstrcmp(objname, tmpname)) TEST_ERROR
-!!$ } /* end for */
-!!$
-!!$ /* Delete last link */
-!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Verify state of group (empty) */
-!!$ if(H5G_has_links_test(group_id, NULL) == TRUE) TEST_ERROR
-!!$ if(H5G_is_new_dense_test(group_id) == TRUE) TEST_ERROR
-!!$
-!!$ /* Check for deletion on empty group again */
-!!$ H5E_BEGIN_TRY {
-!!$ ret = H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT);
-!!$ } H5E_END_TRY;
-!!$ if(ret >= 0) TEST_ERROR
-!!$
-!!$
-!!$ /* Delete links in middle */
-!!$
-!!$
-!!$ /* Create more links, to push group into dense form */
-!!$ for(u = 0; u < (max_compact * 2); u++) {
-!!$ hid_t group_id2; /* Group ID */
-!!$
-!!$ /* Make name for link */
-!!$ sprintf(objname, "filler %02u", u);
-!!$
-!!$ /* Create hard link, with group object */
-!!$ if((group_id2 = H5Gcreate2(group_id, objname, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR
-!!$ if(H5Gclose(group_id2) < 0) TEST_ERROR
-!!$
-!!$ /* Verify state of group (dense) */
-!!$ if(u >= max_compact)
-!!$ if(H5G_is_new_dense_test(group_id) != TRUE) TEST_ERROR
-!!$
-!!$ /* Verify link information for new link */
-!!$ if(link_info_by_idx_check(group_id, objname, (hsize_t)u, TRUE, use_index) < 0) TEST_ERROR
-!!$ } /* end for */
-!!$
-!!$ /* Delete every other link from dense group, in appropriate order */
-!!$ for(u = 0; u < max_compact; u++) {
-!!$ /* Delete link */
-!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)u, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Verify the link information for current link in appropriate order */
-!!$ HDmemset(&linfo, 0, sizeof(linfo));
-!!$ if(H5Lget_info_by_idx(group_id, ".", idx_type, order, (hsize_t)u, &linfo, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(order == H5_ITER_INC) {
-!!$ if(linfo.corder != ((u * 2) + 1)) TEST_ERROR
-!!$ } /* end if */
-!!$ else {
-!!$ if(linfo.corder != ((max_compact * 2) - ((u * 2) + 2))) TEST_ERROR
-!!$ } /* end else */
-!!$
-!!$ /* Verify the name for current link in appropriate order */
-!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
-!!$ if(H5Lget_name_by_idx(group_id, ".", idx_type, order, (hsize_t)u, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(order == H5_ITER_INC)
-!!$ sprintf(objname, "filler %02u", ((u * 2) + 1));
-!!$ else
-!!$ sprintf(objname, "filler %02u", ((max_compact * 2) - ((u * 2) + 2)));
-!!$ if(HDstrcmp(objname, tmpname)) TEST_ERROR
-!!$ } /* end for */
-!!$
-!!$ /* Delete remaining links from dense group, in appropriate order */
-!!$ for(u = 0; u < (max_compact - 1); u++) {
-!!$ /* Delete link */
-!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Verify the link information for first link in appropriate order */
-!!$ HDmemset(&linfo, 0, sizeof(linfo));
-!!$ if(H5Lget_info_by_idx(group_id, ".", idx_type, order, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(order == H5_ITER_INC) {
-!!$ if(linfo.corder != ((u * 2) + 3)) TEST_ERROR
-!!$ } /* end if */
-!!$ else {
-!!$ if(linfo.corder != ((max_compact * 2) - ((u * 2) + 4))) TEST_ERROR
-!!$ } /* end else */
-!!$
-!!$ /* Verify the name for first link in appropriate order */
-!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
-!!$ if(H5Lget_name_by_idx(group_id, ".", idx_type, order, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(order == H5_ITER_INC)
-!!$ sprintf(objname, "filler %02u", ((u * 2) + 3));
-!!$ else
-!!$ sprintf(objname, "filler %02u", ((max_compact * 2) - ((u * 2) + 4)));
-!!$ if(HDstrcmp(objname, tmpname)) TEST_ERROR
-!!$ } /* end for */
-!!$
-!!$ /* Delete last link */
-!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT) < 0) TEST_ERROR
-!!$
-!!$ /* Verify state of group (empty) */
-!!$ if(H5G_has_links_test(group_id, NULL) == TRUE) TEST_ERROR
-!!$ if(H5G_is_new_dense_test(group_id) == TRUE) TEST_ERROR
-!!$
-!!$
-!!$
+
! /* Close the group */
CALL H5Gclose_f(group_id, error)
CALL check("delete_by_idx.H5Gclose_f", error, total_error)
@@ -1941,17 +1286,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
ENDDO
ENDDO
ENDDO
-!!$
-!!$ return 0;
-!!$
-!!$error:
-!!$ H5E_BEGIN_TRY {
-!!$ H5Pclose(gcpl_id);
-!!$ H5Gclose(group_id);
-!!$ H5Fclose(file_id);
-!!$ } H5E_END_TRY;
-!!$ return -1;
-!!$} /* end delete_by_idx() */
+
END SUBROUTINE delete_by_idx
@@ -2056,122 +1391,6 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
! Try with a buffer set to small
-!!$ size_tmp = INT(4,SIZE_T)
-!!$ CALL H5Lget_name_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), size_tmp, tmpname, error)
-!!$ CALL check("H5Lget_name_by_idx_f", error, total_error)
-!!$ CALL verifyString("H5Lget_name_by_idx_f", linkname, tmpname, total_error)
-
-
-!!$
-!!$ if(H5Lget_name_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_INC, n, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(HDstrcmp(linkname, tmpname)) TEST_ERROR
-
-!!$ /* Don't test "native" order if there is no creation order index, since
-!!$ * there's not a good way to easily predict the link's order in the name
-!!$ * index.
-!!$ */
-!!$ if(use_index) {
-!!$ /* Verify the link information for first link, in native creation order (which is increasing) */
-!!$ HDmemset(&linfo, 0, sizeof(linfo));
-!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_NATIVE, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(linfo.corder != 0) TEST_ERROR
-!!$
-!!$ /* Verify the link information for new link, in native creation order (which is increasing) */
-!!$ HDmemset(&linfo, 0, sizeof(linfo));
-!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_NATIVE, n, &linfo, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(linfo.corder != (int64_t)n) TEST_ERROR
-!!$
-!!$ /* Verify value for new soft link, in native creation order (which is increasing) */
-!!$ if(!hard_link) {
-!!$ HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE);
-!!$ if(H5Lget_val_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_NATIVE, n, tmpval, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(HDstrcmp(valname, tmpval)) TEST_ERROR
-!!$ } /* end if */
-!!$
-!!$ /* Verify the name for new link, in native creation order (which is increasing) */
-!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
-!!$ if(H5Lget_name_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_NATIVE, n, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(HDstrcmp(linkname, tmpname)) TEST_ERROR
-!!$ } /* end if */
-!!$
-!!$ /* Verify the link information for first link, in decreasing creation order */
-!!$ HDmemset(&linfo, 0, sizeof(linfo));
-!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, n, &linfo, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(linfo.corder != 0) TEST_ERROR
-!!$
-!!$ /* Verify the link information for new link, in decreasing creation order */
-!!$ HDmemset(&linfo, 0, sizeof(linfo));
-!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(linfo.corder != (int64_t)n) TEST_ERROR
-!!$
-!!$ /* Verify value for new soft link, in decreasing creation order */
-!!$ if(!hard_link) {
-!!$ HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE);
-!!$ if(H5Lget_val_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)0, tmpval, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(HDstrcmp(valname, tmpval)) TEST_ERROR
-!!$ } /* end if */
-!!$
-!!$ /* Verify the name for new link, in decreasing creation order */
-!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
-!!$ if(H5Lget_name_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(HDstrcmp(linkname, tmpname)) TEST_ERROR
-!!$
-!!$
-!!$ /* Verify the link information for first link, in increasing link name order */
-!!$ HDmemset(&linfo, 0, sizeof(linfo));
-!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_INC, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(linfo.corder != 0) TEST_ERROR
-!!$
-!!$ /* Verify the link information for new link, in increasing link name order */
-!!$ HDmemset(&linfo, 0, sizeof(linfo));
-!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_INC, n, &linfo, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(linfo.corder != (int64_t)n) TEST_ERROR
-!!$
-!!$ /* Verify value for new soft link, in increasing link name order */
-!!$ if(!hard_link) {
-!!$ HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE);
-!!$ if(H5Lget_val_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_INC, n, tmpval, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(HDstrcmp(valname, tmpval)) TEST_ERROR
-!!$ } /* end if */
-!!$
-!!$ /* Verify the name for new link, in increasing link name order */
-!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
-!!$ if(H5Lget_name_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_INC, n, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(HDstrcmp(linkname, tmpname)) TEST_ERROR
-!!$
-!!$ /* Don't test "native" order queries on link name order, since there's not
-!!$ * a good way to easily predict the order of the links in the name index.
-!!$ */
-!!$
-!!$ /* Verify the link information for first link, in decreasing link name order */
-!!$ HDmemset(&linfo, 0, sizeof(linfo));
-!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_DEC, n, &linfo, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(linfo.corder != 0) TEST_ERROR
-!!$
-!!$ /* Verify the link information for new link, in decreasing link name order */
-!!$ HDmemset(&linfo, 0, sizeof(linfo));
-!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_DEC, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(linfo.corder != (int64_t)n) TEST_ERROR
-!!$
-!!$ /* Verify value for new soft link, in decreasing link name order */
-!!$ if(!hard_link) {
-!!$ HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE);
-!!$ if(H5Lget_val_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_DEC, (hsize_t)0, tmpval, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(HDstrcmp(valname, tmpval)) TEST_ERROR
-!!$ } /* end if */
-!!$
-!!$ /* Verify the name for new link, in decreasing link name order */
-!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
-!!$ if(H5Lget_name_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_DEC, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR
-!!$ if(HDstrcmp(linkname, tmpname)) TEST_ERROR
-!!$
-!!$ /* Success */
-!!$ return(0);
-!!$
-!!$error:
-!!$ /* Failure */
-!!$ return(-1);
-!!$} /* end link_info_by_idx_check() */
END SUBROUTINE link_info_by_idx_check
@@ -2235,7 +1454,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
INTEGER :: i
INTEGER :: tmp1, tmp2
- WRITE(*,*) "link creation property lists (w/new group format)"
+! WRITE(*,*) "link creation property lists (w/new group format)"
!/* Actually, intermediate group creation is tested elsewhere (tmisc).
@@ -2586,13 +1805,8 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
INTEGER(hsize_t), DIMENSION(2) :: dims
INTEGER(size_t) :: buf_size = 7
- WRITE(*,*) "adjusting nlinks with LAPL (w/new group format)"
+! WRITE(*,*) "adjusting nlinks with LAPL (w/new group format)"
-!!$ /* Make certain test is valid */
-!!$ /* XXX: should probably make a "generic" test that creates the proper
-!!$ * # of links based on this value - QAK
-!!$ */
-!!$ HDassert(H5L_NUM_LINKS == 16);
! /* Create file */
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl)
diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90
index be433c9..7e73104 100644
--- a/fortran/test/tH5O.f90
+++ b/fortran/test/tH5O.f90
@@ -236,7 +236,7 @@ SUBROUTINE test_h5o_plist(total_error)
CHARACTER(LEN=7), PARAMETER :: TEST_FILENAME = 'test.h5'
- PRINT*,'Testing object creation properties'
+! PRINT*,'Testing object creation properties'
!/* Make a FAPL that uses the "use the latest version of the format" flag */
CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error)
generated by cgit v0.12 at 2024-11-18 22:03:21 (GMT)