add %intent() method

Author: scivision

API.md

@@ -187,6 +187,13 @@ tf = is_hdf5('myfile.txt')  !< probably false
 tf = is_hdf5('myfile.h5')  !< true if a valid HDF5 file
 ```
 
+Get the read/write or read-only intent of the HDF5 file.
+
+```fortran
+h % intent(filename)
+!! returns the read/write or read-only intent of the file, e.g. H5F_ACC_RDWR_F, H5F_ACC_RDONLY_F
+```
+
 These are more advanced inquiries into the memory layout of the dataset, for advanced users:
 
 ```fortran

fpm.toml

@@ -30,6 +30,10 @@ main = "test_attributes.f90"
 name = "cast"
 main = "test_cast.f90"
 
+[[test]]
+name = "intent"
+main = "test_intent.f90"
+
 [[test]]
 name = "write"
 main = "test_write.f90"

src/interface.f90

@@ -40,6 +40,7 @@ module h5fortran
 procedure, public :: create => hdf_create_user
 procedure, public :: flush => hdf_flush
 procedure, public :: filesize => hdf_filesize
+procedure, public :: intent => hdf_get_intent
 procedure, public :: ndim => hdf_get_ndim
 procedure, public :: ndims => hdf_get_ndim !< legacy
 procedure, public :: shape => hdf_get_shape
@@ -691,6 +692,11 @@ module subroutine h5close(self, close_hdf5_interface)
 logical, intent(in), optional :: close_hdf5_interface
 end subroutine
 
+module integer function hdf_get_intent(self)
+!! get the intent of an object (read, write, readwrite)
+class(hdf5_file), intent(in) :: self
+end function
+
 module logical function is_open(self)
 !! check if file handle is open
 class(hdf5_file), intent(in) :: self

src/utils.f90

@@ -4,7 +4,7 @@
 h5eset_auto_f, &
 h5iis_valid_f, h5iget_name_f, H5Iget_type_f, &
 h5open_f, h5close_f, &
-H5Fopen_f, h5fcreate_f, h5fclose_f, h5fis_hdf5_f, h5fget_filesize_f, &
+H5Fopen_f, h5fcreate_f, h5fclose_f, h5fis_hdf5_f, h5fget_filesize_f, H5Fget_intent_f, &
 h5fget_obj_count_f, h5fget_obj_ids_f, h5fget_name_f, &
 h5sselect_hyperslab_f, h5screate_simple_f, &
 H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, H5Sget_simple_extent_npoints_f, &
@@ -226,6 +226,16 @@
 end procedure h5close
 
 
+module procedure hdf_get_intent
+
+integer :: ierr
+
+call H5Fget_intent_f(self%file_id, hdf_get_intent, ierr)
+call estop(ierr, "hdf_get_intent:h5fget_intent: could not get file intent", self%filename)
+
+end procedure hdf_get_intent
+
+
 module procedure is_open
 
 integer :: obj_type, ier

test/CMakeLists.txt

@@ -72,7 +72,7 @@ endfunction(setup_test)
 # --- setup unit tests
 
 set(test_names array attributes
-cast deflate_write deflate_read deflate_props destructor exist
+cast deflate_write deflate_read deflate_props destructor exist intent
 groups layout lt scalar shape string version write
 fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable)
 if(HAVE_IEEE_ARITH)

test/test_intent.f90

@@ -0,0 +1,54 @@
+program test
+
+use hdf5
+use h5fortran
+use, intrinsic :: iso_fortran_env, only: stderr=>error_unit
+
+implicit none
+
+type(hdf5_file) :: h
+character(*), parameter :: fn = 'test_intent.h5'
+integer :: intent(5), exp(5), i
+
+call H5open_f(i)
+if(i /= 0) error stop "H5open_f failed [0]"
+
+exp = [H5F_ACC_RDWR_F, H5F_ACC_RDONLY_F, H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F, H5F_ACC_RDWR_F]
+
+!> These are the only two possiblities for the intent of a file
+print '(a,i0)', "H5F_ACC_RDONLY_F = ", H5F_ACC_RDONLY_F
+print '(a,i0)', "H5F_ACC_RDWR_F = ", H5F_ACC_RDWR_F
+
+call h % open(fn, action='w', debug=.true.)
+intent(1) = h % intent()
+call h % close()
+
+call h % open(fn, debug=.true.)
+intent(2) = h % intent()
+call h % close()
+
+call h % open(fn, action='r', debug=.true.)
+intent(3) = h % intent()
+call h % close()
+
+call h % open(fn, action='r+', debug=.true.)
+intent(4) = h % intent()
+call h % close()
+
+call h % open(fn, action='rw', debug=.true.)
+intent(5) = h % intent()
+call h % close()
+
+call H5close_f(i)
+if (i /= 0) error stop "H5close() failed"
+
+if (any(intent /= exp)) then
+    write(stderr, '(a)') 'test_intent: intent does not match expected values'
+    write(stderr, '(5i0)') intent
+    write(stderr, '(5i0)') exp
+    error stop 'intent test failed'
+else
+    print '(a)', 'OK: intent matches expected values'
+end if
+
+end program