make mode handling more robust, correct test error

Author: scivision

CMakeLists.txt

@@ -4,7 +4,7 @@ if(NOT CMAKE_BUILD_TYPE)
 endif()
 project(nc4fortran
   LANGUAGES Fortran
-  VERSION 0.4.4
+  VERSION 0.5.0
   DESCRIPTION "thin, light object-oriented NetCDF4 Fortran interface"
   HOMEPAGE_URL https://github.com/geospace-code/nc4fortran)
 

meson.build

@@ -1,6 +1,6 @@
 project('nc4fortran', 'fortran',
   meson_version : '>=0.52.0',
-  version: '0.4.4',
+  version: '0.5.0',
   default_options : ['default_library=static', 'buildtype=release', 'warning_level=3'])
 
 subdir('meson')

src/interface.f90

@@ -2,7 +2,14 @@ module nc4fortran
 !! NetCDF4 object-oriented polymorphic interface
 use, intrinsic :: iso_c_binding, only : c_ptr, c_loc
 use, intrinsic :: iso_fortran_env, only : real32, real64, int32, int64, stderr=>error_unit
-use netcdf
+
+use netcdf, only : nf90_create, nf90_open, NF90_CLOBBER, NF90_NETCDF4, NF90_MAX_NAME, &
+  NF90_NOERR, NF90_EHDFERR, NF90_EBADNAME, NF90_EBADDIM, NF90_EBADTYPE, NF90_EBADGRPID, NF90_ENOTNC, NF90_ENOTVAR, &
+  NF90_ECHAR, NF90_EEDGE, NF90_ENAMEINUSE, NF90_EBADID, NF90_EINDEFINE, NF90_NOWRITE, &
+  nf90_open, nf90_close, nf90_estride, nf90_inq_varid, nf90_inq_dimid, nf90_inquire_dimension, &
+  nf90_def_dim, nf90_put_att, nf90_def_var, nf90_get_var, nf90_put_var, nf90_float, nf90_double, nf90_int, nf90_int64, &
+  nf90_inq_libvers
+
 use string_utils, only : toLower, strip_trailing_null, truncate_string_null
 
 implicit none (type, external)
@@ -21,6 +28,7 @@ module nc4fortran
 integer :: comp_lvl = 0 !< compression level (1-9)  0: disable compression
 logical :: verbose = .false.
 logical :: debug = .false.
+character(80) :: libversion
 
 contains
 
@@ -217,6 +225,9 @@ subroutine nc_initialize(self,filename,ierr, status,action,comp_lvl,verbose,debu
 if (present(verbose)) self%verbose = verbose
 if (present(debug)) self%debug = debug
 
+!> get library version
+self%libversion = nf90_inq_libvers()
+
 lstatus = 'old'
 if(present(status)) lstatus = toLower(status)
 
@@ -226,20 +237,23 @@ subroutine nc_initialize(self,filename,ierr, status,action,comp_lvl,verbose,debu
 select case(lstatus)
 case ('old', 'unknown')
   select case(laction)
-    case('read','r')  !< Open an existing file.
+    case('read','r')
       ier = nf90_open(self%filename, NF90_NOWRITE, self%ncid)
-    case('write','readwrite','w','rw', 'r+', 'append', 'a')
+    case('r+')
       ier = nf90_open(self%filename, NF90_NETCDF4, self%ncid)
+    case('readwrite', 'rw', 'append', 'a')
+      ier = nf90_open(self%filename, NF90_NETCDF4, self%ncid)
+    case('w','write')
+      ier = nf90_create(self%filename, ior(NF90_CLOBBER, NF90_NETCDF4), self%ncid)
     case default
-      write(stderr,*) 'ERROR:initialize: Unsupported action -> ' // laction
-      ier = 128
+      write(stderr,*) 'Unsupported action -> ' // laction
+      error stop 128
     end select
 case('new','replace')
-  ier = unlink(filename)
-  ier = nf90_create(self%filename, NF90_NETCDF4, self%ncid)
+  ier = nf90_create(self%filename, ior(NF90_CLOBBER, NF90_NETCDF4), self%ncid)
 case default
-  write(stderr,*) 'ERROR:initialize: Unsupported status -> '// lstatus
-  ier = 128
+  write(stderr,*) 'Unsupported status -> '// lstatus
+  error stop 128
 end select
 
 if (present(ierr)) ierr = ier
@@ -314,23 +328,4 @@ logical function check_error(code, dname)
 end function check_error
 
 
-integer function unlink(path) result (ierr)
-!! the non-standard unlink present in some compilers can be unstable
-!! in particular ifort can hang, but not with this standard method
-character(*), intent(in) :: path
-logical :: exists
-integer :: u
-
-ierr = 0
-
-inquire(file=path, exist=exists)
-if(.not.exists) return
-
-open(newunit=u, file=path, status='old', iostat=ierr)
-if(ierr/=0) return
-close(u, status='delete', iostat=ierr)
-
-end function unlink
-
-
 end module nc4fortran

src/tests/test_io.f90

@@ -38,10 +38,11 @@ subroutine test_exist(path)
 
 if (hf%exist('foovar')) error stop 'variable and file not exists and not opened'
 
-call hf%initialize(path // '/scalar.nc', status='replace', action='w')
+call hf%initialize(path // '/scalar.nc', status='replace')
 call hf%write('here', 12)
 if(.not. hf%exist('here')) error stop 'variable exists'
 if(hf%exist('nothere')) error stop 'variable does not actually exist'
+call hf%finalize()
 
 end subroutine test_exist
 
@@ -58,7 +59,7 @@ subroutine test_scalar(path)
 
 !! write
 
-call hf%initialize(path // '/scalar.nc', status='replace', action='rw')
+call hf%initialize(path // '/scalar.nc', status='replace')
 call hf%write('nan', nan)
 call hf%write('scalar_real', 42.)
 call hf%write('scalar_int', 42)
@@ -153,4 +154,4 @@ subroutine test_array(path)
 end subroutine test_array
 
 
-end program
+end program