From 3f043d5cca98bf90146fc81fd7e9d194a2407e9b Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Wed, 17 Sep 2008 10:53:09 -0500 Subject: [svn-r15640] Description: Added test routines for h5t_get/set_fields_f. --- fortran/test/fortranlib_test.f90 | 12 ++- fortran/test/tH5Sselect.f90 | 3 +- fortran/test/tH5T.f90 | 203 ++++++++++++++++++++++++++++++++++++++- 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 -- cgit v0.12