diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2023-05-01 22:21:47 (GMT) |
---|---|---|
committer | GitHub <noreply@github.com> | 2023-05-01 22:21:47 (GMT) |
commit | a0340338e53d4b34127a7e5356b28b1640f9414c (patch) | |
tree | 510fe676640fe3892feb681aca253984fd8df512 /fortran/test/H5_test_buildiface.F90 | |
parent | 9ea976b9b617b0082f5e65f31942c8fbf1a120e1 (diff) | |
download | hdf5-a0340338e53d4b34127a7e5356b28b1640f9414c.zip hdf5-a0340338e53d4b34127a7e5356b28b1640f9414c.tar.gz hdf5-a0340338e53d4b34127a7e5356b28b1640f9414c.tar.bz2 |
Add Fortran Selection IO APIs (#2864)
new selection IO fortran APIs with tests
Diffstat (limited to 'fortran/test/H5_test_buildiface.F90')
-rw-r--r-- | fortran/test/H5_test_buildiface.F90 | 77 |
1 files changed, 60 insertions, 17 deletions
diff --git a/fortran/test/H5_test_buildiface.F90 b/fortran/test/H5_test_buildiface.F90 index 0ea3852..ca945db 100644 --- a/fortran/test/H5_test_buildiface.F90 +++ b/fortran/test/H5_test_buildiface.F90 @@ -133,14 +133,25 @@ PROGRAM H5_test_buildiface WRITE(11,'(A)') '!DEC$endif' ! Subroutine API - WRITE(11,'(A)') ' SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error)' + WRITE(11,'(A)') ' SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error,chck_eq)' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' CHARACTER(LEN=*) :: string' WRITE(11,'(A)') ' INTEGER(KIND='//TRIM(ADJUSTL(chr2))//') :: value, correct_value' WRITE(11,'(A)') ' INTEGER :: total_error' - WRITE(11,'(A)') ' IF (value .NE. correct_value) THEN' - WRITE(11,'(A)') ' total_error=total_error+1' - WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT INTEGER VALIDATION ", string' + WRITE(11,'(A)') ' LOGICAL, OPTIONAL :: chck_eq' + WRITE(11,'(A)') ' LOGICAL :: chck_eq_opt' + WRITE(11,'(A)') ' chck_eq_opt = .TRUE.' + WRITE(11,'(A)') ' IF(PRESENT(chck_eq)) chck_eq_opt = chck_eq' + WRITE(11,'(A)') ' IF(chck_eq_opt .EQV. .TRUE.)THEN' + WRITE(11,'(A)') ' IF (value .NE. correct_value) THEN' + WRITE(11,'(A)') ' total_error=total_error+1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT INTEGER VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' + WRITE(11,'(A)') ' ELSE' + WRITE(11,'(A)') ' IF (value .EQ. correct_value) THEN' + WRITE(11,'(A)') ' total_error=total_error+1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT INTEGER VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' END SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2)) ENDDO @@ -157,14 +168,25 @@ PROGRAM H5_test_buildiface WRITE(11,'(A)') '!DEC$endif' ! Subroutine API - WRITE(11,'(A)') ' SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error)' + WRITE(11,'(A)') ' SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error,chck_eq)' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' CHARACTER(LEN=*) :: string' WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//') :: value, correct_value' WRITE(11,'(A)') ' INTEGER :: total_error' - WRITE(11,'(A)') ' IF (.NOT.real_eq_kind_'//TRIM(ADJUSTL(chr2))//'( value, correct_value) ) THEN' - WRITE(11,'(A)') ' total_error=total_error+1' - WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string' + WRITE(11,'(A)') ' LOGICAL, OPTIONAL :: chck_eq' + WRITE(11,'(A)') ' LOGICAL :: chck_eq_opt' + WRITE(11,'(A)') ' chck_eq_opt = .TRUE.' + WRITE(11,'(A)') ' IF(PRESENT(chck_eq)) chck_eq_opt = chck_eq' + WRITE(11,'(A)') ' IF(chck_eq_opt .EQV. .TRUE.)THEN' + WRITE(11,'(A)') ' IF (.NOT.real_eq_kind_'//TRIM(ADJUSTL(chr2))//'( value, correct_value) ) THEN' + WRITE(11,'(A)') ' total_error=total_error+1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' + WRITE(11,'(A)') ' ELSE' + WRITE(11,'(A)') ' IF (real_eq_kind_'//TRIM(ADJUSTL(chr2))//'( value, correct_value) ) THEN' + WRITE(11,'(A)') ' total_error=total_error+1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' END SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2)) @@ -228,14 +250,25 @@ PROGRAM H5_test_buildiface WRITE(11,'(A)') '!DEC$endif' ! Subroutine API - WRITE(11,'(A)') ' SUBROUTINE verify_character(string,value,correct_value,total_error)' + WRITE(11,'(A)') ' SUBROUTINE verify_character(string,value,correct_value,total_error,chck_eq)' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' CHARACTER*(*) :: string' WRITE(11,'(A)') ' CHARACTER*(*) :: value, correct_value' WRITE(11,'(A)') ' INTEGER :: total_error' - WRITE(11,'(A)') ' IF (TRIM(value) .NE. TRIM(correct_value)) THEN' - WRITE(11,'(A)') ' total_error = total_error + 1' - WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' LOGICAL, OPTIONAL :: chck_eq' + WRITE(11,'(A)') ' LOGICAL :: chck_eq_opt' + WRITE(11,'(A)') ' chck_eq_opt = .TRUE.' + WRITE(11,'(A)') ' IF(PRESENT(chck_eq)) chck_eq_opt = chck_eq' + WRITE(11,'(A)') ' IF(chck_eq_opt .EQV. .TRUE.)THEN' + WRITE(11,'(A)') ' IF (TRIM(value) .NE. TRIM(correct_value)) THEN' + WRITE(11,'(A)') ' total_error = total_error + 1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' + WRITE(11,'(A)') ' ELSE' + WRITE(11,'(A)') ' IF (TRIM(value) .EQ. TRIM(correct_value)) THEN' + WRITE(11,'(A)') ' total_error = total_error + 1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' END SUBROUTINE verify_character' @@ -248,16 +281,26 @@ PROGRAM H5_test_buildiface WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_logical' WRITE(11,'(A)') '!DEC$endif' ! Subroutine API - WRITE(11,'(A)') ' SUBROUTINE verify_logical(string,value,correct_value,total_error)' + WRITE(11,'(A)') ' SUBROUTINE verify_logical(string,value,correct_value,total_error,chck_eq)' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' CHARACTER(LEN=*) :: string' WRITE(11,'(A)') ' LOGICAL :: value, correct_value' WRITE(11,'(A)') ' INTEGER :: total_error' - WRITE(11,'(A)') ' IF (value .NEQV. correct_value) THEN' - WRITE(11,'(A)') ' total_error = total_error + 1' - WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' LOGICAL, OPTIONAL :: chck_eq' + WRITE(11,'(A)') ' LOGICAL :: chck_eq_opt' + WRITE(11,'(A)') ' chck_eq_opt = .TRUE.' + WRITE(11,'(A)') ' IF(PRESENT(chck_eq)) chck_eq_opt = chck_eq' + WRITE(11,'(A)') ' IF(chck_eq_opt .EQV. .TRUE.)THEN' + WRITE(11,'(A)') ' IF (value .NEQV. correct_value) THEN' + WRITE(11,'(A)') ' total_error = total_error + 1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' + WRITE(11,'(A)') ' ELSE' + WRITE(11,'(A)') ' IF (value .EQV. correct_value) THEN' + WRITE(11,'(A)') ' total_error = total_error + 1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' ENDIF' - WRITE(11,'(A)') ' END SUBROUTINE verify_logical' WRITE(11,'(A)') "END MODULE TH5_MISC_gen" |