diff options
| author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2008-05-16 20:46:10 (GMT) |
|---|---|---|
| committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2008-05-16 20:46:10 (GMT) |
| commit | 5c122eeb8b529db62aa75091601f3f91c684b14b (patch) | |
| tree | 6e3443500b9083c30855898a722758feb84f2996 /fortran/test | |
| parent | 6c787d56aa8c7aa0afe0c6be7b340ececc759ff5 (diff) | |
| download | hdf5-5c122eeb8b529db62aa75091601f3f91c684b14b.zip hdf5-5c122eeb8b529db62aa75091601f3f91c684b14b.tar.gz hdf5-5c122eeb8b529db62aa75091601f3f91c684b14b.tar.bz2 | |
[svn-r15025] Purpose:
Cleaned up unused code (i.e. commented out) and removed extraneous output to standard out.
Tested:
N/A - No critical executable source lines were modified, only comments and write statements.
Diffstat (limited to 'fortran/test')
| -rw-r--r-- | fortran/test/fortranlib_test_1_8.f90 | 509 | ||||
| -rw-r--r-- | fortran/test/tH5A_1_8.f90 | 644 | ||||
| -rw-r--r-- | fortran/test/tH5G_1_8.f90 | 928 | ||||
| -rw-r--r-- | fortran/test/tH5O.f90 | 2 |
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) |