mirror of
https://github.com/HDFGroup/hdf5.git
synced 2024-12-03 02:32:04 +08:00
89fbe00dec
* commit '54957d37f5aa73912763dbb6e308555e863c43f4': Commit copyright header change for src/H5PLpkg.c which was added after running script to make changes. Add new files in release_docs to MANIFEST. Cimmit changes to Makefile.in(s) and H5PL.c that resulted from running autogen.sh. Merge pull request #407 in HDFFV/hdf5 from ~LRKNOX/hdf5_lrk:hdf5_1_10_1 to hdf5_1_10_1 Change copyright headers to replace url referring to file to be removed and replace it with new url for COPYING file.
101 lines
3.3 KiB
Fortran
101 lines
3.3 KiB
Fortran
!****h* root/fortran/test/tH5E.f90
|
|
!
|
|
! NAME
|
|
! tH5E.f90
|
|
!
|
|
! FUNCTION
|
|
! Basic testing of Fortran H5E APIs.
|
|
!
|
|
! COPYRIGHT
|
|
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
|
! Copyright by The HDF Group. *
|
|
! Copyright by the Board of Trustees of the University of Illinois. *
|
|
! All rights reserved. *
|
|
! *
|
|
! This file is part of HDF5. The full HDF5 copyright notice, including *
|
|
! terms governing use, modification, and redistribution, is contained in *
|
|
! the COPYING file, which can be found at the root of the source code *
|
|
! distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases. *
|
|
! If you do not have access to either file, you may request a copy from *
|
|
! help@hdfgroup.org. *
|
|
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
|
!
|
|
! NOTES
|
|
! Tests the H5D APIs functionalities of:
|
|
! h5eprint_f
|
|
!
|
|
! CONTAINS SUBROUTINES
|
|
! error_report_test
|
|
!
|
|
!*****
|
|
!
|
|
MODULE TH5E
|
|
|
|
CONTAINS
|
|
|
|
SUBROUTINE error_report_test(cleanup, total_error)
|
|
|
|
! This subroutine tests following functionalities: h5eprint_f
|
|
|
|
USE HDF5 ! This module contains all necessary modules
|
|
USE TH5_MISC
|
|
|
|
IMPLICIT NONE
|
|
LOGICAL, INTENT(IN) :: cleanup
|
|
INTEGER, INTENT(INOUT) :: total_error
|
|
|
|
CHARACTER(LEN=6), PARAMETER :: filename = "etestf" ! File name
|
|
CHARACTER(LEN=80) :: fix_filename
|
|
CHARACTER(LEN=8), PARAMETER :: err_filename = "err_file"! Error output file
|
|
CHARACTER(LEN=80) :: fix_err_filename
|
|
|
|
|
|
|
|
INTEGER(HID_T) :: file_id ! File identifier
|
|
INTEGER(HID_T) :: grp_id ! Group identifier
|
|
INTEGER :: error, tmp_error, err_flag
|
|
|
|
err_flag = 0
|
|
CALL h5eset_auto_f(err_flag, error)
|
|
CALL check("h5eprint_f",error, total_error)
|
|
!
|
|
! 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)
|
|
|
|
!
|
|
! Try to open non-existing group in the file.
|
|
! Error message should go to the err_file_name file.
|
|
!
|
|
CALL h5gopen_f(file_id, "Doesnotexist1", grp_id, tmp_error)
|
|
CALL h5_fixname_f(err_filename, fix_err_filename, H5P_DEFAULT_F, error)
|
|
if (error .ne. 0) then
|
|
write(*,*) "Cannot modify filename"
|
|
stop
|
|
endif
|
|
CALL h5eprint_f(error, fix_err_filename)
|
|
CALL h5gopen_f(file_id, "Doesnotexist2", grp_id, tmp_error)
|
|
CALL h5eprint_f(error, fix_err_filename)
|
|
|
|
!
|
|
! Close the file.
|
|
!
|
|
CALL h5fclose_f(file_id, error)
|
|
CALL check("h5fclose_f",error,total_error)
|
|
|
|
if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
|
|
CALL check("h5_cleanup_f", error, total_error)
|
|
if(cleanup) CALL h5_cleanup_f(err_filename, H5P_DEFAULT_F, error)
|
|
CALL check("h5_cleanup_f", error, total_error)
|
|
RETURN
|
|
END SUBROUTINE error_report_test
|
|
|
|
END MODULE TH5E
|
|
|