From 00cb0fc9951a543de7d0e71c5c6aea2cd1cbb031 Mon Sep 17 00:00:00 2001
From: Elena Pourmal <epourmal@hdfgroup.org>
Date: Thu, 27 Feb 2003 16:29:09 -0500
Subject: [svn-r6443] Purpose:     Bug fix Description:     Added tests for
 enumeration types. Platforms tested:     modi4, artabica, eirene

---
 fortran/test/fortranlib_test.f90 | 10 +++++
 fortran/test/tH5T.f90            | 89 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 99 insertions(+)

diff --git a/fortran/test/fortranlib_test.f90 b/fortran/test/fortranlib_test.f90
index d90fcba..9b00bab 100644
--- a/fortran/test/fortranlib_test.f90
+++ b/fortran/test/fortranlib_test.f90
@@ -37,6 +37,7 @@
      INTEGER :: basic_select_total_error = 0
      INTEGER :: total_error_compoundtest = 0
      INTEGER :: basic_datatype_total_error = 0
+     INTEGER :: enum_total_error = 0
      INTEGER :: external_total_error = 0
      INTEGER :: attribute_total_error = 0
      INTEGER :: identifier_total_error = 0
@@ -206,6 +207,15 @@
      write(*, fmt = e_format) error_string
      total_error = total_error + total_error_compoundtest
 
+     error_string = failure
+     CALL enumtest(cleanup, enum_total_error)
+     IF (enum_total_error == 0) error_string = success
+     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 
+
+
 !     write(*,*)
 !     write(*,*) '========================================='
 !     write(*,*) 'Testing PROPERTY interface               ' 
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index d7669af..d2403d9 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -711,3 +711,92 @@
 
      RETURN
      END SUBROUTINE basic_data_type_test
+
+    SUBROUTINE enumtest(cleanup, total_error)
+
+    USE HDF5
+    IMPLICIT none
+
+    LOGICAL, INTENT(IN)  :: cleanup
+    INTEGER, INTENT(OUT) :: total_error 
+    CHARACTER(LEN=7), PARAMETER :: filename="enum.h5"
+    CHARACTER(LEN=80) :: fix_filename
+    CHARACTER(LEN=8), PARAMETER :: dsetname="enumdset"
+    CHARACTER(LEN=4)            :: true ="TRUE"
+    CHARACTER(LEN=5)            :: false="FALSE"
+    CHARACTER(LEN=5)            :: mem_name 
+
+    INTEGER(HID_T) :: file_id
+    INTEGER(HID_T) :: dset_id
+    INTEGER(HID_T) :: dspace_id
+    INTEGER(HID_T) :: dtype_id
+    INTEGER        :: error
+    INTEGER        :: value
+    INTEGER(HSIZE_T), DIMENSION(1) :: dsize
+    INTEGER(SIZE_T) :: buf_size 
+    INTEGER, DIMENSION(2) :: data
+    INTEGER(HSIZE_T), DIMENSION(7) :: dims
+
+    dims(1) = 2
+    dsize(1) = 2
+    data(1) = 1
+    data(2) = 0
+     !
+     ! Create a new file using default properties.
+     ! 
+          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_id,error)
+        CALL check("h5fcreate_f", error, total_error)
+    !
+    ! Create enumeration datatype with tow values
+    !
+    CALL h5tenum_create_f(H5T_NATIVE_INTEGER,dtype_id,error)
+        CALL check("h5tenum_create_f", error, total_error)
+    CALL h5tenum_insert_f(dtype_id,true,data(1),error)
+        CALL check("h5tenum_insert_f", error, total_error)
+    CALL h5tenum_insert_f(dtype_id,false,data(2),error)
+        CALL check("h5tenum_insert_f", error, total_error)
+    !
+    ! Create write  and close a dataset with enum datatype
+    !
+    CALL h5screate_simple_f(1,dsize,dspace_id,error)
+        CALL check("h5screate_simple_f", error, total_error)
+    CALL h5dcreate_f(file_id,dsetname,dtype_id,dspace_id,dset_id,error)
+        CALL check("h5dcreate_f", error, total_error)
+    CALL h5dwrite_f(dset_id,dtype_id,data,dims,error)
+        CALL check("h5dwrite_f", error, total_error)
+    CALL h5dclose_f(dset_id,error)
+        CALL check("h5dclose_f", error, total_error)
+    CALL h5sclose_f(dspace_id,error)
+        CALL check("h5sclose_f", error, total_error)
+    !
+    ! Get value of "TRUE"
+    !
+    CALL h5tenum_valueof_f(dtype_id, "TRUE", value, error)
+        CALL check("h5tenum_valueof_f", error, total_error)
+        if (value .ne. 1) then
+            write(*,*) " Value of TRUE is not 1, error"
+            total_error = total_error + 1
+        endif 
+    !
+    !  Get name of 0
+    !
+    value = 0
+    buf_size = 5
+    CALL h5tenum_nameof_f(dtype_id,  value, buf_size, mem_name, error)
+         CALL check("h5tenum_nameof_f", error, total_error)
+         if (mem_name .ne. "FALSE") then
+             write(*,*) " Wrong name for 0 value"
+             total_error = total_error + 1
+         endif
+    CALL h5tclose_f(dtype_id,error)
+        CALL check("h5tclose_f", error, total_error)
+    CALL h5fclose_f(file_id,error)
+        CALL check("h5fclose_f", error, total_error)
+    RETURN
+    END SUBROUTINE enumtest 
+
-- 
cgit v0.12