summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'fortran')
-rw-r--r--fortran/test/fortranlib_test_1_8.f9039
-rw-r--r--fortran/test/tH5A_1_8.f9038
-rw-r--r--fortran/test/tH5G_1_8.f9052
3 files changed, 80 insertions, 49 deletions
diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90
index 30d69d7..73f8ac0 100644
--- a/fortran/test/fortranlib_test_1_8.f90
+++ b/fortran/test/fortranlib_test_1_8.f90
@@ -49,31 +49,45 @@ PROGRAM fortranlibtest
ret_total_error = 0
CALL file_space(cleanup, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing file free space', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing file free space', &
+ total_error)
ret_total_error = 0
CALL attribute_test_1_8(cleanup, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing attributes', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing attributes', &
+ total_error)
ret_total_error = 0
CALL group_test(cleanup, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing groups', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing groups', &
+ total_error)
ret_total_error = 0
CALL test_h5o(cleanup, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing object interface', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing object interface', &
+ total_error)
ret_total_error = 0
CALL dtransform(cleanup, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing data transform', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing data transform', &
+ total_error)
ret_total_error = 0
CALL test_genprop_basic_class(cleanup, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing basic generic properties', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing basic generic properties', &
+ total_error)
ret_total_error = 0
CALL test_h5s_encode(cleanup, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing dataspace encoding and decoding', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing dataspace encoding and decoding', &
+ total_error)
! CALL test_hard_query(group_total_error)
@@ -99,8 +113,8 @@ SUBROUTINE dtransform(cleanup, total_error)
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
- INTEGER(HID_T) :: dxpl_id_c_to_f, dxpl_id_c_to_f_copy
- INTEGER(HID_T) :: dxpl_id_simple, dxpl_id_polynomial, dxpl_id_polynomial_copy, dxpl_id_utrans_inv, file_id
+ 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
@@ -166,7 +180,6 @@ SUBROUTINE test_genprop_basic_class(cleanup, total_error)
INTEGER(HID_T) :: cid1 !/* Generic Property class ID */
INTEGER(HID_T) :: cid2 !/* Generic Property class ID */
- INTEGER(HID_T) :: cid3 !/* Generic Property class ID */
CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1"
CHARACTER(LEN=7) :: name ! /* Name of class */
@@ -254,10 +267,10 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
- INTEGER(hid_t) :: sid1, sid2, sid3! /* Dataspace ID */
- INTEGER(hid_t) :: decoded_sid1, decoded_sid2, decoded_sid3
+ 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, null_size=0, scalar_size=0
+ INTEGER(size_t) :: sbuf_size=0, scalar_size=0
! Make sure the size is large, need variable length in fortran 2003
CHARACTER(LEN=288) :: sbuf
diff --git a/fortran/test/tH5A_1_8.f90 b/fortran/test/tH5A_1_8.f90
index 65064ad..01ac2b7 100644
--- a/fortran/test/tH5A_1_8.f90
+++ b/fortran/test/tH5A_1_8.f90
@@ -93,7 +93,9 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
END IF
ret_total_error = 0
CALL test_attr_basic_write(my_fapl, ret_total_error)
- CALL write_test_status(ret_total_error, ' - Tests INT attributes on both datasets and groups', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' - Tests INT attributes on both datasets and groups', &
+ total_error)
!!$ CALL test_attr_basic_read(my_fapl)
!!$ CALL test_attr_flush(my_fapl)
@@ -121,7 +123,8 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
ret_total_error = 0
CALL test_attr_dense_open(my_fcpl, my_fapl, ret_total_error)
CALL write_test_status(ret_total_error, &
- ' - Testing INT attributes on both datasets and groups', total_error)
+ ' - Testing INT attributes on both datasets and groups', &
+ total_error)
!!$ CALL test_attr_dense_delete(my_fcpl, my_fapl)
!!$ CALL test_attr_dense_rename(my_fcpl, my_fapl)
@@ -131,21 +134,26 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
ret_total_error = 0
CALL test_attr_null_space(my_fcpl, my_fapl, ret_total_error)
CALL write_test_status(ret_total_error, &
- ' - Testing storing attribute with "null" dataspace', total_error)
+ ' - Testing storing attribute with "null" dataspace', &
+ total_error)
!!$ CALL test_attr_deprec(fcpl, my_fapl)
ret_total_error = 0
CALL test_attr_many(new_format(i), my_fcpl, my_fapl, ret_total_error)
- CALL write_test_status(ret_total_error, ' - Testing storing lots of attributes', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' - Testing storing lots of attributes', &
+ total_error)
ret_total_error = 0
CALL test_attr_corder_create_basic(my_fcpl, my_fapl, ret_total_error)
CALL write_test_status(ret_total_error, &
- ' - Testing creating objects with attribute creation order', total_error)
+ ' - Testing creating objects with attribute creation order', &
+ total_error)
ret_total_error = 0
CALL test_attr_corder_create_compact(my_fcpl, my_fapl, ret_total_error)
CALL write_test_status(ret_total_error, &
- ' - Testing compact storage on objects with attribute creation order', total_error)
+ ' - Testing compact storage on objects with attribute creation order', &
+ total_error)
!!$ CALL test_attr_corder_create_dense(my_fcpl, my_fapl)
!!$ CALL test_attr_corder_create_reopen(my_fcpl, my_fapl)
!!$ CALL test_attr_corder_transition(my_fcpl, my_fapl)
@@ -153,18 +161,23 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
ret_total_error = 0
CALL test_attr_info_by_idx(new_format, my_fcpl, my_fapl, ret_total_error)
CALL write_test_status(ret_total_error, &
- ' - Testing querying attribute info by index', total_error)
+ ' - Testing querying attribute info by index', &
+ total_error)
ret_total_error = 0
CALL test_attr_delete_by_idx(new_format, my_fcpl, my_fapl, ret_total_error)
- CALL write_test_status(ret_total_error, ' - Testing deleting attribute by index', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' - Testing deleting attribute by index', &
+ total_error)
!!$ CALL test_attr_iterate2(new_format, my_fcpl, my_fapl)
!!$ CALL test_attr_open_by_idx(new_format, my_fcpl, my_fapl)
!!$ CALL test_attr_open_by_name(new_format, my_fcpl, my_fapl)
ret_total_error = 0
CALL test_attr_create_by_name(new_format(i), my_fcpl, my_fapl, ret_total_error)
- CALL write_test_status(ret_total_error, ' - Testing creating attributes by name', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' - Testing creating attributes by name', &
+ total_error)
! /* More complex tests with both "new format" and "shared" attributes */
IF( use_shared(j) ) THEN
@@ -172,12 +185,14 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
ret_total_error = 0
CALL test_attr_shared_rename(my_fcpl, my_fapl, ret_total_error)
CALL write_test_status(ret_total_error,&
- ' - Testing renaming shared attributes in "compact" & "dense" storage', total_error)
+ ' - Testing renaming shared attributes in "compact" & "dense" storage', &
+ total_error)
ret_total_error = 0
CALL test_attr_shared_delete(my_fcpl, my_fapl, ret_total_error)
CALL write_test_status(ret_total_error,&
- ' - Testing deleting shared attributes in "compact" & "dense" storage', total_error)
+ ' - Testing deleting shared attributes in "compact" & "dense" storage', &
+ total_error)
!!$ CALL test_attr_shared_unlink(my_fcpl, my_fapl)
@@ -2944,7 +2959,6 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
INTEGER(HID_T) :: attr,attr2 !String Attribute identifier
INTEGER(HID_T) :: group
- INTEGER(HSIZE_T), DIMENSION(7) :: data_dims
CHARACTER(LEN=25) :: check_name
CHARACTER(LEN=18) :: chr_exact_size
diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90
index 65c2a29..832ba43 100644
--- a/fortran/test/tH5G_1_8.f90
+++ b/fortran/test/tH5G_1_8.f90
@@ -43,40 +43,58 @@ SUBROUTINE group_test(cleanup, total_error)
ret_total_error = 0
CALL mklinks(fapl2, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing building a file with assorted links', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing building a file with assorted links', &
+ total_error)
ret_total_error = 0
CALL cklinks(fapl2, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing links are correct and building assorted links', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing links are correct and building assorted links', &
+ total_error)
ret_total_error = 0
CALL group_info(cleanup, fapl2, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing create group with creation order indices, test querying group info', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing create group with creation order indices, test querying group info', &
+ total_error)
! CALL ud_hard_links(fapl2,total_error)
ret_total_error = 0
CALL timestamps(cleanup, fapl2, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing disabling tracking timestamps for an object', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing disabling tracking timestamps for an object', &
+ total_error)
ret_total_error = 0
CALL test_move_preserves(fapl2, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing moving and renaming links preserves their properties', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing moving and renaming links preserves their properties', &
+ total_error)
ret_total_error = 0
CALL delete_by_idx(cleanup,fapl2,ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing deleting links by index', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing deleting links by index', &
+ total_error)
ret_total_error = 0
CALL test_lcpl(cleanup, fapl, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing link creation property lists', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing link creation property lists', &
+ total_error)
ret_total_error = 0
CALL objcopy(fapl, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing object copy', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing object copy', &
+ total_error)
ret_total_error = 0
CALL lifecycle(cleanup, fapl2, ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing adding links to a group follow proper "lifecycle"', total_error)
+ CALL write_test_status(ret_total_error, &
+ ' Testing adding links to a group follow proper "lifecycle"', &
+ total_error)
IF(cleanup) CALL h5_cleanup_f("TestLinks", H5P_DEFAULT_F, error)
CALL check("h5_cleanup_f", error, total_error)
@@ -692,7 +710,6 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
INTEGER(HID_T):: group_id
INTEGER(HID_T):: fcpl_id ! /* Group creation property list ID */
INTEGER(HID_T):: lcpl_id
- INTEGER(HID_T):: lcpl2_id
!H5O_info_t oinfo;
!H5L_info_t linfo;
INTEGER :: old_cset
@@ -901,18 +918,13 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
INTEGER(HID_T) :: fid !/* File ID */
INTEGER(HID_T) :: gid !/* Group ID */
- INTEGER(HID_T) :: gid2 !/* Datatype ID */
INTEGER(HID_T) :: gcpl !/* Group creation property list ID */
INTEGER(size_t) :: lheap_size_hint !/* Local heap size hint */
INTEGER :: max_compact !/* Maximum # of links to store in group compactly */
INTEGER :: min_dense !/* Minimum # of links to store in group "densely" */
INTEGER :: est_num_entries !/* Estimated # of entries in group */
INTEGER :: est_name_len !/* Estimated length of entry name */
- INTEGER :: nmsgs !/* Number of messages in group's header */
- CHARACTER(LEN=NAME_BUF_SIZE) :: objname ! /* Object name */
CHARACTER(LEN=NAME_BUF_SIZE) :: filename = 'fixx.h5'
- INTEGER :: empty_size ! /* Size of an empty file */
- INTEGER :: u ! /* Local index variable */
INTEGER(SIZE_T) :: LIFECYCLE_LOCAL_HEAP_SIZE_HINT = 256
INTEGER :: LIFECYCLE_MAX_COMPACT = 4
INTEGER :: LIFECYCLE_MIN_DENSE = 3
@@ -1054,7 +1066,6 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
! H5L_info_t linfo2;
CHARACTER(LEN=12), PARAMETER :: filename ='TestLinks.h5'
- CHARACTER(LEN=12) :: linkval
! TYPE(C_PTR) :: linkval
@@ -1130,7 +1141,6 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
CHARACTER(LEN=7) :: objname ! /* Object name */
CHARACTER(LEN=8) :: filename = 'file0.h5' ! /* File name */
- CHARACTER(LEN=7) :: tmpname ! /* Temporary link name */
CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME = "corder_group"
LOGICAL :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute
@@ -1148,11 +1158,8 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
!
!
!
- CHARACTER(LEN=6) :: filename1
- CHARACTER(LEN=6) :: filename2
CHARACTER(LEN=80) :: fix_filename1
CHARACTER(LEN=80) :: fix_filename2
- INTEGER(SIZE_T) :: size_tmp
INTEGER(HSIZE_T) :: htmp
LOGICAL :: cleanup
@@ -1356,7 +1363,6 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CHARACTER(LEN=10) :: tmpname_big !/* to big temporary link name */
CHARACTER(LEN=7) :: valname !/* Link value name */
- CHARACTER(LEN=7) :: tmpval !/* Temporary link value */
CHARACTER(LEN=2) :: chr2
INTEGER(SIZE_T) :: size_tmp
INTEGER :: error
@@ -1463,7 +1469,6 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
! H5L_LINK_ERROR _F - Error
INTEGER :: address ! If the link is a hard link, address specifies the file address that the link points to
INTEGER(HSIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value
- INTEGER(HSIZE_T) :: data_size ! Indicates the size, in the number of characters, of the attribute
CHARACTER(LEN=1024) :: filename = 'tempfile.h5'
INTEGER, PARAMETER :: TEST6_DIM1 = 8, TEST6_DIM2 = 7
@@ -1819,14 +1824,13 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
INTEGER(HID_T) :: fid = (-1) !/* File ID */
INTEGER(HID_T) :: gid = (-1), gid2 = (-1) !/* Group IDs */
INTEGER(HID_T) :: plist = (-1) ! /* lapl ID */
- INTEGER(HID_T) :: tid = (-1), sid = (-1), did = (-1) ! /* Other IDs */
+ INTEGER(HID_T) :: tid = (-1) ! /* Other IDs */
INTEGER(HID_T) :: gapl = (-1), dapl = (-1), tapl = (-1) ! /* Other property lists */
CHARACTER(LEN=7) :: objname ! /* Object name */
INTEGER(size_t) :: name_len ! /* Length of object name */
CHARACTER(LEN=12) :: filename = 'TestLinks.h5'
INTEGER(size_t) :: nlinks ! /* nlinks for H5Pset_nlinks */
- INTEGER(hsize_t), DIMENSION(2) :: dims
INTEGER(size_t) :: buf_size = 7
! WRITE(*,*) "adjusting nlinks with LAPL (w/new group format)"
generated by cgit v0.12 at 2024-11-01 12:07:40 (GMT)