[svn-r27630] Description:

    Bring in changes from the trunk, through r27628.

Tested on:
    MacOSX/64 10.10.5 (amazon) w/serial
    (h5committest not required on this branch)

1 files changed, 469 insertions, 0 deletions

diff --git a/fortran/test/tH5MISC_1_8.F90 b/fortran/test/tH5MISC_1_8.F90
new file mode 100644
index 0000000..ba3f095
--- /dev/null
+++ b/fortran/test/tH5MISC_1_8.F90
@@ -0,0 +1,469 @@
+!****h* root/fortran/test/tH5MISC_1_8.f90
+!
+! NAME
+!  tH5MISC_1_8.f90
+!
+! FUNCTION
+!  Basic testing of Fortran API's introduced in 1.8 release.
+!
+! COPYRIGHT
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!   Copyright by The HDF Group.                                               *
+!   Copyright by the Board of Trustees of the University of Illinois.         *
+!   All rights reserved.                                                      *
+!                                                                             *
+!   This file is part of HDF5.  The full HDF5 copyright notice, including     *
+!   terms governing use, modification, and redistribution, is contained in    *
+!   the files COPYING and Copyright.html.  COPYING can be found at the root   *
+!   of the source code distribution tree; Copyright.html can be found at the  *
+!   root level of an installed copy of the electronic HDF5 document set and   *
+!   is linked from the top-level documents page.  It can also be found at     *
+!   http://hdfgroup.org/HDF5/doc/Copyright.html.  If you do not have          *
+!   access to either file, you may request a copy from help@hdfgroup.org.     *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+!*****
+MODULE TH5MISC_1_8
+
+  USE HDF5 ! This module contains all necessary modules
+  USE TH5_MISC
+  USE TH5_MISC_GEN
+
+CONTAINS
+
+SUBROUTINE dtransform(cleanup, total_error)
+
+  IMPLICIT NONE
+  LOGICAL, INTENT(IN)  :: cleanup
+  INTEGER, INTENT(INOUT) :: total_error
+
+  INTEGER(HID_T) :: dxpl_id_c_to_f
+  INTEGER(HID_T) :: file_id
+
+  CHARACTER(LEN=15), PARAMETER :: c_to_f = "(9/5.0)*x + 123"
+  INTEGER :: error
+  CHARACTER(LEN=15) :: ptrgetTest
+  CHARACTER(LEN=7) :: ptrgetTest_small
+  CHARACTER(LEN=30) :: ptrgetTest_big
+
+  INTEGER(SIZE_T) :: size
+
+  CALL H5Fcreate_f("dtransform.h5", H5F_ACC_TRUNC_F, file_id, error)
+  CALL check("dtransform.H5Fcreate_f", error, total_error)
+
+  CALL H5Pcreate_f(H5P_DATASET_XFER_F, dxpl_id_c_to_f, error)
+  CALL check("dtransform.H5Pcreate_f", error, total_error)
+
+  CALL H5Pset_data_transform_f(dxpl_id_c_to_f, c_to_f, error)
+  CALL check("dtransform.H5Pset_data_transform_f", error, total_error)
+
+  CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest, error, size=size)
+  CALL check("dtransform.H5Pget_data_transform_f",  error, total_error)
+  CALL verify("dtransform.H5Pget_data_transform_f", c_to_f, ptrgetTest, total_error)
+  CALL verify("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
+
+! check case when receiving buffer to small
+
+  CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_small, error, size=size)
+  CALL check("dtransform.H5Pget_data_transform_f",  error, total_error)
+  CALL verify("dtransform.H5Pget_data_transform_f", c_to_f(1:7), ptrgetTest_small, total_error)
+  CALL verify("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
+
+! check case when receiving buffer to big
+
+  CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_big, error, size=size)
+  CALL check("dtransform.H5Pget_data_transform_f",  error, total_error)
+  CALL verify("dtransform.H5Pget_data_transform_f", c_to_f(1:15), ptrgetTest_big(1:15), total_error)
+  CALL verify("dtransform.H5Pget_data_transform_f", INT(size), 15, total_error)
+
+  CALL H5Fclose_f(file_id, error)
+  CALL check("H5Fclose_f", error, total_error)
+
+  IF(cleanup) CALL h5_cleanup_f("dtransform", H5P_DEFAULT_F, error)
+  CALL check("h5_cleanup_f", error, total_error)
+
+END SUBROUTINE dtransform
+
+
+!***************************************************************
+!**
+!**  test_genprop_basic_class(): Test basic generic property list code.
+!**      Tests creating new generic classes.
+!**
+!***************************************************************
+
+SUBROUTINE test_genprop_basic_class(total_error)
+
+  IMPLICIT NONE
+  INTEGER, INTENT(INOUT) :: total_error
+
+  INTEGER(HID_T) :: cid1    ! Generic Property class ID 
+  INTEGER(HID_T) :: cid2    ! Generic Property class ID 
+
+  CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1"
+  CHARACTER(LEN=7)  :: name              !  Name of class 
+  CHARACTER(LEN=10) :: name_big          !  Name of class bigger buffer 
+  CHARACTER(LEN=4)  :: name_small        !  Name of class smaller buffer
+  INTEGER :: error
+  INTEGER :: size
+  LOGICAL :: flag
+
+  ! Output message about test being performed 
+
+  !WRITE(*,*) "Testing Basic Generic Property List Class Creation Functionality"
+
+  ! Try some bogus value for class identifier; function should fail gracefully
+
+  cid1 = 456
+  CALL H5Pget_class_name_f(cid1, name, size, error)
+  CALL verify("H5Pget_class_name", error, -1, error)
+
+  !  Create a new generic class, derived from the root of the class hierarchy 
+  CALL H5Pcreate_class_f(H5P_ROOT_F, CLASS1_NAME, cid1, error)
+  CALL check("H5Pcreate_class", error, total_error)
+
+  !  Check class name 
+  CALL H5Pget_class_name_f(cid1, name, size, error)
+  CALL check("H5Pget_class_name", error, total_error)
+  CALL verify("H5Pget_class_name", size,7,error)
+  CALL verify("H5Pget_class_name", name, CLASS1_NAME, error)
+  IF(error.NE.0)THEN
+     WRITE(*,*) 'Class names do not match! name=',name, 'CLASS1_NAME=',CLASS1_NAME
+     total_error = total_error + 1
+  ENDIF
+
+  !  Check class name smaller buffer
+  CALL H5Pget_class_name_f(cid1, name_small, size, error)
+  CALL check("H5Pget_class_name", error, total_error)
+  CALL verify("H5Pget_class_name", size,7,error)
+  CALL verify("H5Pget_class_name", name_small(1:4), CLASS1_NAME(1:4), error)
+  IF(error.NE.0)THEN
+     WRITE(*,*) 'Class names do not match! name=',name_small(1:4), 'CLASS1_NAME=',CLASS1_NAME(1:4)
+     total_error = total_error + 1
+  ENDIF
+
+  !  Check class name bigger buffer
+  CALL H5Pget_class_name_f(cid1, name_big, size, error)
+  CALL check("H5Pget_class_name", error, total_error)
+  CALL verify("H5Pget_class_name", size,7,error)
+  CALL verify("H5Pget_class_name", TRIM(name_big), TRIM(CLASS1_NAME), error)
+  IF(error.NE.0)THEN
+     WRITE(*,*) 'Class names do not match! name=',TRIM(name_small), 'CLASS1_NAME=',TRIM(CLASS1_NAME)
+     total_error = total_error + 1
+  ENDIF
+
+  !  Check class parent 
+  CALL H5Pget_class_parent_f(cid1, cid2, error)
+  CALL check("H5Pget_class_parent_f", error, total_error)
+
+  !  Verify class parent correct 
+  CALL H5Pequal_f(cid2, H5P_ROOT_F, flag, error)
+  CALL check("H5Pequal_f", error, total_error)
+  CALL verify("H5Pequal_f", flag, .TRUE., total_error)
+
+
+  !  Make certain false postives aren't being returned 
+  CALL H5Pequal_f(cid2, H5P_FILE_CREATE_F, flag, error)
+  CALL check("H5Pequal_f", error, total_error)
+  CALL verify("H5Pequal_f", flag, .FALSE., total_error)
+
+  ! Close parent class 
+  CALL H5Pclose_class_f(cid2, error)
+  CALL check("H5Pclose_class_f", error, total_error)
+
+
+  ! Close class 
+  CALL H5Pclose_class_f(cid1, error)
+  CALL check("H5Pclose_class_f", error, total_error)
+
+END SUBROUTINE test_genprop_basic_class
+
+SUBROUTINE test_h5s_encode(total_error)
+
+!***************************************************************
+!**
+!**  test_h5s_encode(): Test H5S (dataspace) encoding and decoding.
+!**
+!***************************************************************
+
+  IMPLICIT NONE
+  INTEGER, INTENT(INOUT) :: total_error
+
+  INTEGER(hid_t) :: sid1, sid3!	 Dataspace ID		
+  INTEGER(hid_t) :: decoded_sid1, decoded_sid3
+  INTEGER :: rank    ! LOGICAL rank of dataspace	
+  INTEGER(size_t) :: sbuf_size=0, scalar_size=0
+
+! Make sure the size is large
+  CHARACTER(LEN=288) :: sbuf
+  CHARACTER(LEN=288) :: scalar_buf
+
+  INTEGER(hsize_t) :: n !  Number of dataspace elements 
+
+  INTEGER(hsize_t), DIMENSION(1:3) :: start = (/0, 0, 0/)
+  INTEGER(hsize_t), DIMENSION(1:3) :: stride = (/2, 5, 3/)
+  INTEGER(hsize_t), DIMENSION(1:3) :: count = (/2, 2, 2/)
+  INTEGER(hsize_t), DIMENSION(1:3) :: BLOCK = (/1, 3, 1/)
+
+  INTEGER :: space_type
+  !
+  ! Dataset dimensions
+  !
+  INTEGER, PARAMETER :: SPACE1_DIM1= 3,  SPACE1_DIM2=15, SPACE1_DIM3=13
+
+  INTEGER(HSIZE_T), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/)
+  INTEGER :: SPACE1_RANK = 3
+  INTEGER :: error
+
+  !-------------------------------------------------------------------------
+  ! * Test encoding and decoding of simple dataspace and hyperslab selection.
+  ! *-------------------------------------------------------------------------
+  ! 
+
+  CALL H5Screate_simple_f(SPACE1_RANK, dims1, sid1, error)
+  CALL check("H5Screate_simple", error, total_error)
+
+  CALL h5sselect_hyperslab_f(sid1, H5S_SELECT_SET_F, &
+       start, count, error, stride=stride, BLOCK=BLOCK)
+  CALL check("h5sselect_hyperslab_f", error, total_error)
+
+
+  ! Encode simple data space in a buffer 
+
+  !         First find the buffer size
+  CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
+  CALL check("H5Sencode", error, total_error)
+
+
+  !  Try decoding bogus buffer 
+
+  CALL H5Sdecode_f(sbuf, decoded_sid1, error)
+  CALL verify("H5Sdecode", error, -1, total_error)
+
+  CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
+  CALL check("H5Sencode", error, total_error)
+
+  !  Decode from the dataspace buffer and return an object handle 
+  CALL H5Sdecode_f(sbuf, decoded_sid1, error)
+  CALL check("H5Sdecode", error, total_error)
+
+
+  !  Verify the decoded dataspace 
+  CALL h5sget_simple_extent_npoints_f(decoded_sid1, n, error)
+  CALL check("h5sget_simple_extent_npoints_f", error, total_error)
+  CALL verify("h5sget_simple_extent_npoints_f", INT(n), INT(SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3), &
+       total_error)
+
+  !
+  !Close the dataspace for the dataset.
+  !
+  CALL h5sclose_f(sid1, error)
+  CALL check("h5sclose_f", error, total_error)
+
+  CALL h5sclose_f(decoded_sid1, error)
+  CALL check("h5sclose_f", error, total_error)
+
+  ! -------------------------------------------------------------------------
+  !  * Test encoding and decoding of scalar dataspace.
+  !  *-------------------------------------------------------------------------
+  !  
+  !  Create scalar dataspace 
+
+  CALL H5Screate_f(H5S_SCALAR_F, sid3, error)
+  CALL check("H5Screate_f",error, total_error)
+
+  !  Encode scalar data space in a buffer 
+
+  !        First find the buffer size
+  CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error)
+  CALL check("H5Sencode_f", error, total_error)
+
+  ! encode
+
+  CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error)
+  CALL check("H5Sencode_f", error, total_error)
+
+
+  !  Decode from the dataspace buffer and return an object handle 
+
+  CALL H5Sdecode_f(scalar_buf, decoded_sid3, error)
+  CALL check("H5Sdecode_f", error, total_error)
+
+
+  !  Verify extent type 
+
+  CALL H5Sget_simple_extent_type_f(decoded_sid3, space_type, error)
+  CALL check("H5Sget_simple_extent_type_f", error, total_error)
+  CALL verify("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error)
+
+  !  Verify decoded dataspace 
+  CALL h5sget_simple_extent_npoints_f(decoded_sid3, n, error)
+  CALL check("h5sget_simple_extent_npoints_f", error, total_error)
+  CALL verify("h5sget_simple_extent_npoints_f", INT(n), 1, total_error)
+
+  CALL H5Sget_simple_extent_ndims_f(decoded_sid3, rank, error)
+  CALL CHECK("H5Sget_simple_extent_ndims_f", error, total_error)
+  CALL verify("H5Sget_simple_extent_ndims_f", rank, 0, total_error )
+
+  CALL h5sclose_f(sid3, error)
+  CALL check("h5sclose_f", error, total_error)
+
+  CALL h5sclose_f(decoded_sid3, error)
+  CALL check("h5sclose_f", error, total_error)
+
+END SUBROUTINE test_h5s_encode
+
+!-------------------------------------------------------------------------
+! Function:    test_scaleoffset
+!
+! Purpose:     Tests the integer datatype for scaleoffset filter
+!              with fill value set
+!
+! Return:      Success:        0
+!              Failure:        >0
+!
+! Programmer:  M. Scot Breitenfeld
+!              Decemeber 11, 2010
+!
+! Modifications:
+!
+!-------------------------------------------------------------------------
+!
+
+SUBROUTINE test_scaleoffset(cleanup, total_error )
+
+  IMPLICIT NONE
+  LOGICAL, INTENT(IN)  :: cleanup
+  INTEGER, INTENT(INOUT) :: total_error
+  INTEGER(hid_t) :: file
+
+  INTEGER(hid_t)   :: dataset, datatype, space, mspace, dc
+  INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2, 5/)
+  INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2, 5/)
+  INTEGER, DIMENSION(1:2,1:5) :: orig_data
+  INTEGER, DIMENSION(1:2,1:5) :: new_data
+  INTEGER(hsize_t), DIMENSION(1:2) :: start  ! Start of hyperslab 
+  INTEGER(hsize_t), DIMENSION(1:2) :: stride ! Stride of hyperslab
+  INTEGER(hsize_t), DIMENSION(1:2) :: count  ! BLOCK count
+  INTEGER(hsize_t), DIMENSION(1:2) :: BLOCK  ! BLOCK sizes
+  INTEGER :: fillval
+  INTEGER(size_t) :: j
+  REAL :: x
+  INTEGER :: error
+  LOGICAL :: status
+
+  ! check to see if filter is available
+  CALL H5Zfilter_avail_f(H5Z_FILTER_SCALEOFFSET_F, status, error)
+  IF(.NOT.status)THEN ! We don't have H5Z_FILTER_SCALEOFFSET_F filter
+     total_error = -1       ! so return
+     RETURN
+  ENDIF
+
+  CALL H5Fcreate_f("h5scaleoffset.h5", H5F_ACC_TRUNC_F, file, error)
+  CALL check("H5Fcreate_f", error, total_error)
+
+  CALL H5Tcopy_f(H5T_NATIVE_INTEGER, datatype, error)
+  CALL CHECK(" H5Tcopy_f", error, total_error)
+
+  ! Set order of dataset datatype
+  CALL H5Tset_order_f(datatype, H5T_ORDER_BE_F, error)
+  CALL CHECK(" H5Tset_order_f", error, total_error)
+
+  ! Create the data space for the dataset
+  CALL H5Screate_simple_f(2, dims, space, error)
+  CALL CHECK(" H5Screate_simple_f", error, total_error)
+
+  ! Create the dataset property list  
+  CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error)
+  CALL CHECK(" H5Pcreate_f", error, total_error)
+
+  ! Set fill value 
+  fillval = 10000
+  CALL H5Pset_fill_value_f(dc, H5T_NATIVE_INTEGER, fillval, error)
+  CALL CHECK(" H5Pset_fill_value_f", error, total_error)
+
+  ! Set up to use scaleoffset filter, let library calculate minbits
+  CALL H5Pset_chunk_f(dc, 2, chunk_dim, error)
+  CALL CHECK(" H5Pset_chunk_f", error, total_error)
+  
+  CALL H5Pset_scaleoffset_f(dc, H5Z_SO_INT_F, H5Z_SO_INT_MINBITS_DEFAULT_F, error)
+  CALL CHECK(" H5Pset_scaleoffset_f", error, total_error)
+  
+  ! Create the dataset
+  CALL H5Dcreate_f(file, "scaleoffset_int", datatype, &
+       space, dataset, error, dc)
+  CALL CHECK(" H5Dcreate_f", error, total_error)
+
+  ! Create the memory data space
+  CALL H5Screate_simple_f(2, dims, mspace, error)
+  CALL CHECK(" H5Screate_simple_f", error, total_error)
+
+  ! Select hyperslab for data to write, using 1x5 blocks,
+  ! (1,1) stride and (1,1) count starting at the position (0,0)
+     
+  start(1:2) = (/0,0/)
+  stride(1:2) = (/1,1/)
+  COUNT(1:2) = (/1,1/)
+  BLOCK(1:2) = (/1,5/)
+
+  CALL H5Sselect_hyperslab_f(mspace, H5S_SELECT_SET_F, start, &
+       count, error, stride, BLOCK)
+  CALL CHECK(" H5Sselect_hyperslab_f", error, total_error)
+
+  CALL RANDOM_SEED()
+  ! Initialize data of hyperslab
+  DO j = 1, INT(dims(2))
+     CALL RANDOM_NUMBER(x)
+     orig_data(1,j) = INT(x*10000.)
+     IF(MOD(j,2_size_t).EQ.0)THEN
+        orig_data(1,j) = - orig_data(1,j)
+     ENDIF
+  ENDDO
+
+  !----------------------------------------------------------------------
+  ! STEP 1: Test scaleoffset by setting up a chunked dataset and writing
+  ! to it.
+  !----------------------------------------------------------------------
+  
+  ! Only data in the hyperslab will be written, other value should be fill value 
+  CALL H5Dwrite_f(dataset, H5T_NATIVE_INTEGER, orig_data, dims, error, mspace, mspace, H5P_DEFAULT_F)
+  CALL CHECK(" H5Dwrite_f", error, total_error)
+
+  !----------------------------------------------------------------------
+  ! STEP 2: Try to read the data we just wrote.
+  !----------------------------------------------------------------------
+     
+  ! Read the dataset back
+  
+  CALL H5Dread_f(dataset, H5T_NATIVE_INTEGER, new_data, dims, error, mspace, mspace, H5P_DEFAULT_F)
+  CALL CHECK(" H5Dread_f", error, total_error)
+
+  ! Check that the values read are the same as the values written 
+  DO j = 1, INT(dims(2))
+     IF(new_data(1,j) .NE. orig_data(1,j))THEN
+        total_error = total_error + 1
+        WRITE(*,'("    Read different values than written.")')
+        WRITE(*,'("    At index ", 2(1X,I0))') 1, j
+        EXIT
+     ENDIF
+  ENDDO
+  !----------------------------------------------------------------------
+  ! Cleanup
+  !----------------------------------------------------------------------
+  CALL H5Tclose_f(datatype, error)
+  CALL CHECK(" H5Tclose_f", error, total_error)
+  CALL H5Pclose_f(dc, error)
+  CALL CHECK(" H5Pclose_f", error, total_error)
+  CALL H5Sclose_f(space, error)
+  CALL CHECK(" H5Sclose_f", error, total_error)
+  CALL H5Dclose_f(dataset, error)
+  CALL CHECK(" H5Dclose_f", error, total_error)
+  CALL H5Fclose_f(file, error)
+  CALL CHECK(" H5Fclose_f", error, total_error)
+
+  IF(cleanup) CALL h5_cleanup_f("h5scaleoffset", H5P_DEFAULT_F, error)
+  CALL check("h5_cleanup_f", error, total_error)
+
+END SUBROUTINE test_scaleoffset
+
+END MODULE TH5MISC_1_8