From 4caf8e52db2ed2ef48aeed5f4f6df2f226b6f89a Mon Sep 17 00:00:00 2001 From: "Michael Hirsch, Ph.D" Date: Mon, 24 Feb 2020 11:02:26 -0500 Subject: [PATCH] write: check matching shape for existing disk variable --- src/tests/test_array.f90 | 4 ++++ src/write.f90 | 2 ++ 2 files changed, 6 insertions(+) diff --git a/src/tests/test_array.f90 b/src/tests/test_array.f90 index 2bc3c75e..532c1468 100644 --- a/src/tests/test_array.f90 +++ b/src/tests/test_array.f90 @@ -47,6 +47,10 @@ subroutine test_write_array(path) if(ierr/=0) error stop call h5f%write('/nan', nan, ierr) if(ierr/=0) error stop +!> test writing wrong size +call h5f%write('/int32-1d', [-1], ierr) +if(ierr==0) error stop 'did not error for write array shape mismatch' + call h5f%finalize(ierr) if(ierr/=0) error stop diff --git a/src/write.f90 b/src/write.f90 index 86b1eb3a..8351930f 100644 --- a/src/write.f90 +++ b/src/write.f90 @@ -46,6 +46,8 @@ if (check(ierr, 'ERROR: setup_write: ' // dname // ' check exist ' // self%filename)) return if(exists) then + call hdf_shape_check(self, dname, dims, ierr) + if (ierr/=0) return !> open dataset call h5dopen_f(self%lid, dname, did, ierr) if (check(ierr, 'ERROR: setup_write: open ' // dname // ' ' // self%filename)) return