[svn-r15640] Description:

Added test routines for h5t_get/set_fields_f.

3 files changed, 214 insertions, 4 deletions

diff --git a/fortran/test/fortranlib_test.f90 b/fortran/test/fortranlib_test.f90
index c3abf51..1033eef 100644
--- a/fortran/test/fortranlib_test.f90
+++ b/fortran/test/fortranlib_test.f90
@@ -48,6 +48,7 @@
      INTEGER :: vl_total_error = 0
      INTEGER :: z_total_error = 0
      INTEGER :: sz_total_error = 0
+     INTEGER :: derived_flt_error = 0
      INTEGER :: majnum, minnum, relnum
      CHARACTER(LEN=8) error_string
      CHARACTER(LEN=8) :: success = ' PASSED '
@@ -224,7 +225,16 @@
      write(*, fmt = '(19a)', advance = 'no') ' Enum datatype test'     
      write(*, fmt = '(51x,a)', advance = 'no')  ' '
      write(*, fmt = e_format) error_string
-     total_error = total_error + enum_total_error 
+     total_error = total_error + enum_total_error
+
+     error_string = failure
+     CALL test_derived_flt(cleanup, derived_flt_error)
+     IF (derived_flt_error == 0) error_string = success
+     write(*, fmt = '(28a)', advance = 'no') ' Derived float datatype test'     
+     write(*, fmt = '(47x,a)', advance = 'no')  ' '
+     write(*, fmt = e_format) error_string
+     total_error = total_error + derived_flt_error
+ 
 !     write(*,*)
 !     write(*,*) '========================================='
 !     write(*,*) 'Testing PROPERTY interface               ' 
diff --git a/fortran/test/tH5Sselect.f90 b/fortran/test/tH5Sselect.f90
index a004ba7..2a3bfd4 100644
--- a/fortran/test/tH5Sselect.f90
+++ b/fortran/test/tH5Sselect.f90
@@ -918,8 +918,7 @@
      CALL check("h5sget_select_hyper_blocklist_f", error, total_error)
      !write(*,*) (blocklist(i), i =1, num_blocks*RANK*2)
      !result of blocklist selected is:
-     !1,  1,  2,  2,  4,  1,  5,  2,  1,  4,  2,  5,  4,  4,  5,  5     
-
+     !1,  1,  2,  2,  4,  1,  5,  2,  1,  4,  2,  5,  4,  4,  5,  5
      !
      !deallocate the blocklist array
      !
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index 9901a53..0648cac 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -883,5 +883,206 @@
     CALL h5fclose_f(file_id,error)
         CALL check("h5fclose_f", error, total_error)
     RETURN
-    END SUBROUTINE enumtest 
+    END SUBROUTINE enumtest
+
+!/*-------------------------------------------------------------------------
+! * Function:    test_derived_flt
+! *
+! * Purpose:     Tests user-define and query functions of floating-point types.
+! *              test h5tget/set_fields_f.
+! *
+! * Return:      Success:        0
+! *
+! *              Failure:        number of errors
+! *
+! * Fortran Programmer:  M.S. Breitenfeld
+! *                      September 9, 2008
+! *
+! * Modifications:
+! *
+! *-------------------------------------------------------------------------
+! */
+
+SUBROUTINE test_derived_flt(cleanup, total_error) 
+
+  USE HDF5 ! This module contains all necessary modules 
+  
+  IMPLICIT NONE
+  LOGICAL, INTENT(IN)  :: cleanup
+  INTEGER, INTENT(OUT) :: total_error
+  INTEGER(hid_t) :: file=-1, tid1=-1, tid2=-1
+  INTEGER(hid_t) :: dxpl_id=-1
+  INTEGER(size_t) :: spos, epos, esize, mpos, msize, size
+  
+  CHARACTER(LEN=15), PARAMETER :: filename="h5t_derived_flt"
+  CHARACTER(LEN=80) :: fix_filename
+
+  INTEGER(SIZE_T) :: precision1, offset1, ebias1, size1
+  INTEGER(SIZE_T) :: precision2, offset2, ebias2, size2
+
+  INTEGER :: error
+
+  !/* Create File */
+  CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
+  IF (error .NE. 0) THEN
+     WRITE(*,*) "Cannot modify filename"
+     STOP
+  ENDIF
+
+  CALL h5fcreate_f(fix_filename,H5F_ACC_TRUNC_F,file,error)
+  CALL check("h5fcreate_f", error, total_error)
+  
+  CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, error)
+  CALL check("h5pcreate_f", error, total_error)
+
+  CALL h5tcopy_f(H5T_IEEE_F64LE, tid1, error)
+  CALL check("h5tcopy_f",error,total_error)
+
+  CALL h5tcopy_f(H5T_IEEE_F32LE, tid2, error)
+  CALL check("h5tcopy_f",error,total_error)
+
+  !/*------------------------------------------------------------------------
+  ! *                   1st floating-point type
+  ! * size=7 byte, precision=42 bits, offset=3 bits, mantissa size=31 bits,
+  ! * mantissa position=3, exponent size=10 bits, exponent position=34,
+  ! * exponent bias=511.  It can be illustrated in little-endian order as
+  ! *
+  ! *          6       5       4       3       2       1       0
+  ! *    ???????? ???SEEEE EEEEEEMM MMMMMMMM MMMMMMMM MMMMMMMM MMMMM???
+  ! *
+  ! * To create a new floating-point type, the following properties must be
+  ! * set in the order of
+  ! *   set fields -> set offset -> set precision -> set size.
+  ! * All these properties must be set before the type can function. Other
+  ! * properties can be set anytime.  Derived type size cannot be expanded
+  ! * bigger than original size but can be decreased.  There should be no
+  ! * holes among the significant bits.  Exponent bias usually is set
+  ! * 2^(n-1)-1, where n is the exponent size.
+  ! *-----------------------------------------------------------------------*/
+
+  CALL H5Tset_fields_f(tid1, INT(44,size_t), INT(34,size_t), INT(10,size_t), &
+       INT(3,size_t), INT(31,size_t), error)
+  CALL check("H5Tset_fields_f",error,total_error)
+
+  CALL H5Tset_offset_f(tid1, INT(3,size_t), error)
+  CALL check("H5Tset_offset_f",error,total_error)
+
+  CALL H5Tset_precision_f(tid1, INT(42,size_t), error)
+  CALL check("H5Tset_precision_f",error,total_error)
+
+  CALL H5Tset_size_f(tid1, INT(7,size_t), error)
+  CALL check("H5Tset_size_f",error,total_error)
+
+  CALL H5Tset_ebias_f(tid1, INT(511,size_t), error)
+  CALL check("H5Tset_ebias_f",error,total_error)
+
+  CALL H5Tset_pad_f(tid1, H5T_PAD_ZERO_F, H5T_PAD_ZERO_F, error)
+  CALL check("H5Tset_pad_f",error,total_error)
+
+  CALL h5tcommit_f(file, "new float type 1", tid1, error)
+  CALL check("h5tcommit_f", error, total_error)
+
+  CALL h5tclose_f(tid1, error)
+  CALL check("h5tclose_f", error, total_error)
+
+  CALL H5Topen_f(file, "new float type 1", tid1, error)
+  CALL check("H5Topen_f", error, total_error)
+
+  CALL H5Tget_fields_f(tid1, spos, epos, esize, mpos, msize, error)
+  CALL check("H5Tget_fields_f", error, total_error)
+
+  IF(spos.NE.44 .OR. epos.NE.34 .OR. esize.NE.10 .OR. mpos.NE.3 .OR. msize.NE.31)THEN
+     CALL VERIFY("H5Tget_fields_f", -1, 0, total_error)
+  ENDIF
+
+  CALL H5Tget_precision_f(tid1, precision1, error)
+  CALL check("H5Tget_precision_f", error, total_error)
+  CALL VERIFY("H5Tget_precision_f", INT(precision1), 42, total_error) 
+
+  CALL H5Tget_offset_f(tid1, offset1, error)
+  CALL check("H5Tget_offset_f", error, total_error)
+  CALL VERIFY("H5Tget_offset_f", INT(offset1), 3, total_error)
+
+  CALL H5Tget_size_f(tid1, size1, error)
+  CALL check("H5Tget_size_f", error, total_error)
+  CALL VERIFY("H5Tget_size_f", INT(size1), 7, total_error)
+
+  CALL H5Tget_ebias_f(tid1, ebias1, error)
+  CALL check("H5Tget_ebias_f", error, total_error)
+  CALL VERIFY("H5Tget_ebias_f", INT(ebias1), 511, total_error)
+
+  !/*--------------------------------------------------------------------------
+  ! *                   2nd floating-point type
+  ! * size=3 byte, precision=24 bits, offset=0 bits, mantissa size=16 bits,
+  ! * mantissa position=0, exponent size=7 bits, exponent position=16, exponent
+  ! * bias=63. It can be illustrated in little-endian order as
+  ! *
+  ! *          2       1       0
+  ! *    SEEEEEEE MMMMMMMM MMMMMMMM
+  ! *--------------------------------------------------------------------------*/
+
+  CALL H5Tset_fields_f(tid2, INT(23,size_t), INT(16,size_t), INT(7,size_t), &
+       INT(0,size_t), INT(16,size_t), error)
+  CALL check("H5Tset_fields_f",error,total_error)
+
+  CALL H5Tset_offset_f(tid2, INT(0,size_t), error)
+  CALL check("H5Tset_offset_f",error,total_error)
+
+  CALL H5Tset_precision_f(tid2, INT(24,size_t), error)
+  CALL check("H5Tset_precision_f",error,total_error)
+
+  CALL H5Tset_size_f(tid2, INT(3,size_t), error)
+  CALL check("H5Tset_size_f",error,total_error)
+
+  CALL H5Tset_ebias_f(tid2, INT(63,size_t), error)
+  CALL check("H5Tset_ebias_f",error,total_error)
+
+  CALL H5Tset_pad_f(tid2, H5T_PAD_ZERO_F, H5T_PAD_ZERO_F, error)
+  CALL check("H5Tset_pad_f",error,total_error)
+
+  CALL h5tcommit_f(file, "new float type 2", tid2, error)
+  CALL check("h5tcommit_f", error, total_error)
+
+  CALL h5tclose_f(tid2, error)
+  CALL check("h5tclose_f", error, total_error)
+
+  CALL H5Topen_f(file, "new float type 2", tid2, error)
+  CALL check("H5Topen_f", error, total_error)
+
+  CALL H5Tget_fields_f(tid2, spos, epos, esize, mpos, msize, error)
+  CALL check("H5Tget_fields_f", error, total_error)
+
+  IF(spos.NE.23 .OR. epos.NE.16 .OR. esize.NE.7 .OR. mpos.NE.0 .OR. msize.NE.16)THEN
+     CALL VERIFY("H5Tget_fields_f", -1, 0, total_error)
+  ENDIF
+
+  CALL H5Tget_precision_f(tid2, precision2, error)
+  CALL check("H5Tget_precision_f", error, total_error)
+  CALL VERIFY("H5Tget_precision_f", INT(precision2), 24, total_error) 
+
+  CALL H5Tget_offset_f(tid2, offset2, error)
+  CALL check("H5Tget_offset_f", error, total_error)
+  CALL VERIFY("H5Tget_offset_f", INT(offset2), 0, total_error)
+
+  CALL H5Tget_size_f(tid2, size2, error)
+  CALL check("H5Tget_size_f", error, total_error)
+  CALL VERIFY("H5Tget_size_f", INT(size2), 3, total_error)
+
+  CALL H5Tget_ebias_f(tid2, ebias2, error)
+  CALL check("H5Tget_ebias_f", error, total_error)
+  CALL VERIFY("H5Tget_ebias_f", INT(ebias2), 63, total_error)
+
+  CALL h5tclose_f(tid1, error)
+  CALL check("h5tclose_f", error, total_error)
+
+  CALL h5tclose_f(tid2, error)
+  CALL check("h5tclose_f", error, total_error)
+
+  CALL H5Pclose_f(dxpl_id, error)
+  CALL check("H5Pclose_f", error, total_error)
+
+  CALL h5fclose_f(file,error)
+  CALL check("h5fclose_f", error, total_error)
+
+END SUBROUTINE test_derived_flt