[svn-r2714]

Purpose:
    Added more Fortran tests
Description:
    tH5A.f90 - attribute interface test
    tH5I.f90 - identifier interface test
Solution:
    Two new files were added to test H5A and H5I interfaces.
Platforms tested:
    Solaris 2.7, Linux

1 files changed, 140 insertions, 94 deletions

diff --git a/fortran/test/fortranlib_test.f90 b/fortran/test/fortranlib_test.f90
index 40c323b..2724dad 100644
--- a/fortran/test/fortranlib_test.f90
+++ b/fortran/test/fortranlib_test.f90
@@ -4,10 +4,6 @@
 !
      PROGRAM fortranlibtest
 
-       !USE H5FTEST
-       !USE H5DTEST
-       !USE H5RTEST
-       !USE H5STEST
        USE HDF5
 
      IMPLICIT NONE
@@ -26,141 +22,191 @@
      INTEGER :: total_error_compoundtest = 0
      INTEGER :: basic_datatype_total_error = 0
      INTEGER :: external_total_error = 0
+     INTEGER :: attribute_total_error = 0
+     INTEGER :: identifier_total_error = 0
+     CHARACTER*8 error_string
+     CHARACTER*8 :: success = ' PASSED '
+     CHARACTER*8 :: failure = '*FAILED*'
+     CHARACTER*2 :: e_format = "a8"
 
      CALL h5init_types_f(error) 
-     write(*,*)
-     write(*,*) "Testing File Interface"
-
+     write(*,*) '============================================================================='
+     write(*,*) '                              FORTRAN tests '
+     write(*,*) '============================================================================='
+!     write(*,*) '========================================='
+!     write(*,*) 'Testing FILE Interface                   '
+!     write(*,*) '========================================='
+
+     write(*, fmt = '14a', advance = 'no') ' Mounting test'     
+     write(*, fmt = '57x', advance = 'no') 
+     error_string = failure
      CALL mountingtest(mounting_total_error)
-     IF (mounting_total_error == 0) THEN
-         write(*,*) "mounting test OK"
-     ELSE
-         write(*,*) "mounting test FAILED"
-     END IF
+     IF (mounting_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string 
      total_error = total_error + mounting_total_error 
 
+     write(*, fmt = '12a', advance = 'no') ' Reopen test'     
+     write(*, fmt = '59x', advance = 'no') 
+     error_string = failure
      CALL reopentest(reopen_total_error)
-     IF (reopen_total_error == 0) THEN
-         write(*,*) "Reopen test OK"
-     ELSE
-         write(*,*) "Reopen test FAILED"
-     END IF
+     IF (reopen_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
      total_error = total_error + reopen_total_error 
 
 
+!     write(*,*)
+!     write(*,*) '========================================='
+!     write(*,*) 'Testing DATASET Interface                '
+!     write(*,*) '========================================='
 
-     write(*,*)
-     write(*,*) "Testing Dataset Interface"
-
+     write(*, fmt = '13a', advance = 'no') ' Dataset test'     
+     write(*, fmt = '58x', advance = 'no') 
+     error_string = failure
      CALL datasettest(dataset_total_error)
-     IF (dataset_total_error == 0) THEN
-         write(*,*) "dataset test OK"
-     ELSE
-         write(*,*) "dataset test FAILED"
-     END IF
+     IF (dataset_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
      total_error = total_error + dataset_total_error 
 
+     write(*, fmt = '24a', advance = 'no') ' Extendible dataset test'     
+     write(*, fmt = '47x', advance = 'no') 
+     error_string = failure
      CALL extenddsettest(extend_dataset_total_error)
-     IF (extend_dataset_total_error == 0) THEN
-         write(*,*) "extend dataset test OK"
-     ELSE
-         write(*,*) "extend dataset test FAILED"
-     END IF
+     IF (extend_dataset_total_error == 0)  error_string = success
+     write(*, fmt = e_format) error_string
      total_error = total_error + extend_dataset_total_error 
 
-     write(*,*)
-     write(*,*) "Testing DATASPACE Interface"
+!     write(*,*)
+!     write(*,*) '========================================='
+!     write(*,*) 'Testing DATASPACE Interface             '
+!     write(*,*) '========================================='
 
+     write(*, fmt = '21a', advance = 'no') ' Basic dataspace test'     
+     write(*, fmt = '50x', advance = 'no') 
+     error_string = failure
      CALL dataspace_basic_test(dataspace_total_error)
-     IF (dataspace_total_error == 0) THEN
-         write(*,*) "dataspce basic test OK"
-     ELSE
-         write(*,*) "dataspace basic test FAILED"
-     END IF
+     IF (dataspace_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
      total_error = total_error + dataspace_total_error 
 
 
-     write(*,*)
-     write(*,*) "Testing Reference Interface"
+!     write(*,*)
+!     write(*,*) '========================================='
+!     write(*,*) 'Testing REFERENCE Interface              '
+!     write(*,*) '========================================='
 
+     write(*, fmt = '25a', advance = 'no') ' Reference to object test'     
+     write(*, fmt = '46x', advance = 'no') 
+     error_string = failure
      CALL refobjtest(refobj_total_error)
-     IF (refobj_total_error == 0) THEN
-         write(*,*) "Reference to object test OK"
-     ELSE
-         write(*,*) "Reference to object test FAILED"
-     END IF
+     IF (refobj_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
      total_error = total_error + refobj_total_error 
 
+     write(*, fmt = '33a', advance = 'no') ' Reference to dataset region test'     
+     write(*, fmt = '38x', advance = 'no') 
+     error_string = failure
      CALL refregtest(refreg_total_error)
-     IF (refreg_total_error == 0) THEN
-         write(*,*) "Refernce to Region test OK"
-     ELSE
-         write(*,*) "Refernce to Region test FAILED"
-     END IF
+     IF (refreg_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
      total_error = total_error + refreg_total_error 
 
-     write(*,*)
-     write(*,*) "Testing selection functionalities"
+!     write(*,*)
+!     write(*,*) '========================================='
+!     write(*,*) 'Testing selection functionalities        '
+!     write(*,*) '========================================='
 
+     write(*, fmt = '21a', advance = 'no') ' Basic selection test'     
+     write(*, fmt = '50x', advance = 'no') 
+     error_string = failure
+     CALL test_basic_select(basic_select_total_error)
+     IF (basic_select_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
+     total_error = total_error + basic_select_total_error 
+
+     write(*, fmt = '25a', advance = 'no') ' Hyperslab selection test'     
+     write(*, fmt = '46x', advance = 'no') 
+     error_string = failure
      CALL  test_select_hyperslab( hyperslab_total_error)
-     IF ( hyperslab_total_error == 0) THEN
-         write(*,*) "hyperslab selection test OK"
-     ELSE
-         write(*,*) "hyperslab selection test FAILED"
-     END IF
+     IF ( hyperslab_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
      total_error = total_error + hyperslab_total_error 
 
+     write(*, fmt = '23a', advance = 'no') ' Element selection test'     
+     write(*, fmt = '48x', advance = 'no') 
+     error_string = failure
      CALL test_select_element(element_total_error)
-     IF (element_total_error == 0) THEN
-         write(*,*) "element selection test OK"
-     ELSE
-         write(*,*) "element selection test FAILED"
-     END IF
+     IF (element_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
      total_error = total_error + element_total_error 
 
-     CALL test_basic_select(basic_select_total_error)
-     IF (basic_select_total_error == 0) THEN
-         write(*,*) "basic selection test OK"
-     ELSE
-         write(*,*) "basic selection test FAILED"
-     END IF
-     total_error = total_error + basic_select_total_error 
-     write(*,*)
 
-     write(*,*) "Testing Compound Datatypes"
-     CALL compoundtest(total_error_compoundtest)
-     IF (total_error_compoundtest == 0) THEN
-         write(*,*) "Compound Datatype test OK"
-     ELSE
-         write(*,*) "Compound Datatype test FAILED"
-     END IF
-     total_error = total_error + total_error_compoundtest
+!     write(*,*)
+!     write(*,*) '========================================='
+!     write(*,*) 'Testing DATATYPE interface               '
+!     write(*,*) '========================================='
 
-     write(*,*)
-     write(*,*) "Testing basic datatype functionalities"
+     write(*, fmt = '20a', advance = 'no') ' Basic datatype test'     
+     write(*, fmt = '51x', advance = 'no') 
+     error_string = failure
      CALL basic_data_type_test(basic_datatype_total_error)
-     IF (basic_datatype_total_error == 0) THEN
-         write(*,*) "Basic Datatype test OK"
-     ELSE
-         write(*,*) "Basic Datatype test FAILED"
-     END IF
+     IF (basic_datatype_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
      total_error = total_error + basic_datatype_total_error 
 
-     write(*,*)
-     write(*,*) "Testing external functionalities"
+     write(*, fmt = '23a', advance = 'no') ' Compound datatype test'     
+     write(*, fmt = '48x', advance = 'no') 
+     error_string = failure
+     CALL compoundtest(total_error_compoundtest)
+     IF (total_error_compoundtest == 0) error_string = success
+     write(*, fmt = e_format) error_string
+     total_error = total_error + total_error_compoundtest
+
+!     write(*,*)
+!     write(*,*) '========================================='
+!     write(*,*) 'Testing PROPERTY interface               ' 
+!     write(*,*) '========================================='
+
+     write(*, fmt = '22a', advance = 'no') ' External dataset test'     
+     write(*, fmt = '49x', advance = 'no') 
+     error_string = failure
      CALL external_test(external_total_error)
-     IF (external_total_error == 0) THEN
-         write(*,*) "External test OK"
-     ELSE
-         write(*,*) "External test FAILED"
-     END IF
+     IF (external_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
      total_error = total_error + external_total_error 
+    
+!     write(*,*)
+!     write(*,*) '========================================='
+!     write(*,*) 'Testing ATTRIBUTE interface              ' 
+!     write(*,*) '========================================='
+
+     write(*, fmt = '15a', advance = 'no') ' Attribute test'     
+     write(*, fmt = '56x', advance = 'no') 
+     error_string = failure
+     CALL attribute_test(attribute_total_error)
+     IF (attribute_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
+     total_error = total_error + attribute_total_error 
+
+!     write(*,*)
+!     write(*,*) '========================================='
+!     write(*,*) 'Testing IDENTIFIER interface             '
+!     write(*,*) '========================================='
+
+     write(*, fmt = '16a', advance = 'no') ' Identifier test'     
+     write(*, fmt = '55x', advance = 'no') 
+     error_string = failure
+     CALL identifier_test(identifier_total_error)
+     IF (identifier_total_error == 0) error_string = success
+     write(*, fmt = e_format) error_string
+     total_error = total_error + identifier_total_error 
 
      write(*,*)
 
-     if (total_error .eq. 0) write(*,*) "Fortran_lib test passed!"
-     if (total_error.gt. 0) write(*,*) "Fortran_lib test failed with ",&
-                                           total_error, " error(s)"
+     write(*,*) '============================================================================='
+     write(*, fmt = "15x, 27a", advance='NO') ' FORTRAN tests completed with '
+     write(*, fmt = "i4", advance='NO') total_error
+     write(*, fmt = "12a" ) ' error(s) ! '
+     write(*,*) '============================================================================='
 
      CALL h5close_types_f(error)