From 0a896c59a89bce87c83255bb2ca4bda31accfd4b Mon Sep 17 00:00:00 2001 From: Elena Pourmal Date: Tue, 6 May 2008 13:01:59 -0500 Subject: [svn-r14941] Maintenance: Cleaned up more test code, fixed more bugs in the test and source codes. This check-in should address Fortran failures on liberty and smirom. Platforms tested: kagiso with Intel, smirom with g95 -fPIC, liberty with gfortran42 --- fortran/src/H5Af.c | 4 +- fortran/src/H5f90proto.h | 2 +- fortran/test/tH5A_1_8.f90 | 110 ++++++---------------------------------------- 3 files changed, 16 insertions(+), 100 deletions(-) diff --git a/fortran/src/H5Af.c b/fortran/src/H5Af.c index 3b6feb0..9818258 100644 --- a/fortran/src/H5Af.c +++ b/fortran/src/H5Af.c @@ -1652,7 +1652,7 @@ done: *---------------------------------------------------------------------------*/ int_f nh5aexists_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, _fcd attr_name, size_t_f *attr_namelen, - hid_t_f *lapl_id, hid_t_f *attr_exists) + hid_t_f *lapl_id, int_f *attr_exists) { char *c_obj_name = NULL; /* Buffer to hold object name C string */ char *c_attr_name = NULL; /* Buffer to hold attribute name C string */ @@ -1669,7 +1669,7 @@ nh5aexists_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, _fc /* * Call H5Aexists_by_name function. */ - if((*attr_exists = (hid_t_f)H5Aexists_by_name((hid_t)*loc_id, c_obj_name, c_attr_name, (hid_t)*lapl_id)) < 0) + if((*attr_exists = (int_f)H5Aexists_by_name((hid_t)*loc_id, c_obj_name, c_attr_name, (hid_t)*lapl_id)) < 0) HGOTO_DONE(FAIL); done: diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 03060f0..4c8aabf 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -595,7 +595,7 @@ H5_FCDLL int_f nh5acreate_by_name_c(hid_t_f *loc_id, _fcd obj_name, size_t_f *ob hid_t_f *lapl_id, hid_t_f *attr_id ); /* MSB */ H5_FCDLL int_f nh5aexists_c (hid_t_f *obj_id, _fcd name, size_t_f *namelen, hid_t_f *attr_exists); /* MSB */ H5_FCDLL int_f nh5aexists_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, _fcd attr_name, size_t_f *attr_namelen, - hid_t_f *lapl_id, hid_t_f *attr_exists); /* MSB */ + hid_t_f *lapl_id, int_f *attr_exists); /* MSB */ H5_FCDLL int_f nh5aopen_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, _fcd attr_name, size_t_f *attr_namelen, hid_t_f *aapl_id, hid_t_f *lapl_id, hid_t_f *attr_id); /* MSB */ H5_FCDLL int_f nh5arename_c( hid_t_f *loc_id, diff --git a/fortran/test/tH5A_1_8.f90 b/fortran/test/tH5A_1_8.f90 index 9704cf7..cbd1614 100644 --- a/fortran/test/tH5A_1_8.f90 +++ b/fortran/test/tH5A_1_8.f90 @@ -3284,37 +3284,29 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) CHARACTER(LEN=25) :: check_name CHARACTER(LEN=18) :: chr_exact_size - INTEGER, PARAMETER :: SPACE1_RANK = 3 - INTEGER, PARAMETER :: NX = 20 - INTEGER, PARAMETER :: NY = 5 - INTEGER, PARAMETER :: NZ = 10 -! INTEGER(HSIZE_T), DIMENSION(3) :: dims1 = (/NX,NY,NZ/) + INTEGER, PARAMETER :: SPACE1_RANK = 2 CHARACTER(LEN=5), PARAMETER :: ATTR1_NAME="Attr1" - INTEGER, PARAMETER :: ATTR1_RANK = 1 - INTEGER, PARAMETER :: ATTR1_DIM1 = 3 + INTEGER, PARAMETER :: ATTR1_RANK = 1 + INTEGER, PARAMETER :: ATTR1_DIM1 = 3 CHARACTER(LEN=7), PARAMETER :: ATTR1A_NAME ="Attr1_a" CHARACTER(LEN=18), PARAMETER :: ATTR_TMP_NAME = "Attr1_a-1234567890" -! int attr_data1a[ATTR1_DIM1]={256,11945,-22107}; - INTEGER, DIMENSION(ATTR1_DIM1), PARAMETER :: attr_data1 =(/258,9987,-99890/) + INTEGER, DIMENSION(ATTR1_DIM1) :: attr_data1 INTEGER, DIMENSION(ATTR1_DIM1) :: attr_data1a INTEGER, DIMENSION(ATTR1_DIM1) :: read_data1 INTEGER(HSIZE_T) :: attr_size ! attributes storage requirements .MSB. -! INTEGER :: attr_data1 - INTEGER(HSIZE_T), DIMENSION(2) :: dims2 = (/4,6/) ! Dataset dimensions + INTEGER(HSIZE_T), DIMENSION(1) :: dimsa = (/3/) ! Dataset dimensions -!!!! start INTEGER :: rank1 = 2 ! Dataspace1 rank INTEGER(HSIZE_T), DIMENSION(2) :: dims1 = (/4,6/) ! Dataset dimensions INTEGER(HSIZE_T), DIMENSION(2) :: maxdims1 = (/4,6/) ! maximum dimensions INTEGER(SIZE_T) :: size -! Not setting it as a parameter but intialize caused error -! Look into. -Scot- -! attr_data1(1) = 258 -! attr_data1(2) = 9987 -! attr_data1(3) = -99890 +!! Initialize attribute data + attr_data1(1) = 258 + attr_data1(2) = 9987 + attr_data1(3) = -99890 attr_data1a(1) = 258 attr_data1a(2) = 1087 @@ -3329,16 +3321,14 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) ! /* Create dataspace for dataset */ CALL h5screate_simple_f(rank1, dims1, sid1, error, maxdims1) -! CALL h5screate_simple_f(SPACE1_RANK, dims1, sid1, error) CALL check("h5screate_simple_f",error,total_error) ! /* Create a dataset */ -! sid1 = H5Screate_simple(SPACE1_RANK, dims1, NULL); CALL h5dcreate_f(fid1, DSET1_NAME, H5T_NATIVE_CHARACTER, sid1, dataset, error, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F ) CALL check("h5dcreate_f",error,total_error) ! /* Create dataspace for attribute */ - CALL h5screate_simple_f(ATTR1_RANK, dims2, sid2, error) + CALL h5screate_simple_f(ATTR1_RANK, dimsa, sid2, error) CALL check("h5screate_simple_f",error,total_error) ! /* Try to create an attribute on the file (should create an attribute on root group) */ @@ -3370,9 +3360,8 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) CALL check("h5acreate_f",error,total_error) ! /* Write attribute information */ - data_dims(1) = 3 - CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_data1, data_dims, error) + CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_data1, dimsa, error) CALL check("h5awrite_f",error,total_error) ! /* Create an another attribute for the dataset */ @@ -3380,7 +3369,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) CALL check("h5acreate_f",error,total_error) ! /* Write attribute information */ - CALL h5awrite_f(attr2, H5T_NATIVE_INTEGER, attr_data1a, data_dims, error) + CALL h5awrite_f(attr2, H5T_NATIVE_INTEGER, attr_data1a, dimsa, error) CALL check("h5awrite_f",error,total_error) ! /* Check storage size for attribute */ @@ -3393,7 +3382,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) ! VERIFY(attr_size, (ATTR1_DIM1 * sizeof(int)), "H5A_get_storage_size"); ! /* Read attribute information immediately, without closing attribute */ - CALL h5aread_f(attr, H5T_NATIVE_INTEGER, read_data1, data_dims, error) + CALL h5aread_f(attr, H5T_NATIVE_INTEGER, read_data1, dimsa, error) CALL check("h5aread_f",error,total_error) ! /* Verify values read in */ @@ -3452,88 +3441,15 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) ! /* Close attribute */ CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) -!!$ -!!$ /* Open the second attribute again */ -!!$ attr2=H5Aopen(dataset, ATTR1A_NAME, H5P_DEFAULT); -!!$ CHECK(attr, FAIL, "H5Aopen"); -!!$ -!!$ /* Verify new attribute name */ -!!$ attr_name_size = H5Aget_name(attr2, (size_t)0, NULL); -!!$ CHECK(attr_name_size, FAIL, "H5Aget_name"); -!!$ -!!$ if(attr_name_size>0) -!!$ attr_name = (char*)HDcalloc((size_t)(attr_name_size+1), sizeof(char)); -!!$ -!!$ ret=(herr_t)H5Aget_name(attr2, (size_t)(attr_name_size+1), attr_name); -!!$ CHECK(ret, FAIL, "H5Aget_name"); -!!$ ret=HDstrcmp(attr_name, ATTR1A_NAME); -!!$ VERIFY(ret, 0, "HDstrcmp"); -!!$ -!!$ if(attr_name) -!!$ HDfree(attr_name); -!!$ -!!$ /* Read attribute information immediately, without closing attribute */ -!!$ ret=H5Aread(attr2,H5T_NATIVE_INT,read_data1); -!!$ CHECK(ret, FAIL, "H5Aread"); -!!$ -!!$ /* Verify values read in */ -!!$ for(i=0; i