Skip to content

Commit 10f9438

Browse files
authored
Merge pull request #600 from ivan-pi/npy
Fix iomsg allocation in save_npy
2 parents 4069d81 + 1974cb4 commit 10f9438

File tree

2 files changed

+26
-2
lines changed

2 files changed

+26
-2
lines changed

src/stdlib_io_npy_save.fypp

+3-1
Original file line numberDiff line numberDiff line change
@@ -128,7 +128,9 @@ contains
128128
end if
129129

130130
if (present(iomsg)) then
131-
iomsg = "Failed to write array to file '"//filename//"'"
131+
if (stat /= 0) then
132+
iomsg = "Failed to write array to file '"//filename//"'"
133+
end if
132134
end if
133135
end subroutine save_npy_${t1[0]}$${k1}$_${rank}$
134136
#:endfor

src/tests/io/test_npy.f90

+23-1
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,8 @@ subroutine collect_npy(testsuite)
3434
new_unittest("duplicate-descr", test_duplicate_descr, should_fail=.true.), &
3535
new_unittest("missing-descr", test_missing_descr, should_fail=.true.), &
3636
new_unittest("missing-fortran_order", test_missing_fortran_order, should_fail=.true.), &
37-
new_unittest("missing-shape", test_missing_shape, should_fail=.true.) &
37+
new_unittest("missing-shape", test_missing_shape, should_fail=.true.), &
38+
new_unittest("iomsg-deallocated", test_iomsg_deallocated) &
3839
]
3940
end subroutine collect_npy
4041

@@ -619,6 +620,27 @@ subroutine test_missing_shape(error)
619620
call check(error, stat, msg)
620621
end subroutine test_missing_shape
621622

623+
subroutine test_iomsg_deallocated(error)
624+
!> Error handling
625+
type(error_type), allocatable, intent(out) :: error
626+
627+
integer :: stat
628+
character(len=:), allocatable :: msg
629+
630+
character(len=*), parameter :: filename = ".test-iomsg-deallocated.npy"
631+
real(sp), allocatable :: input(:, :), output(:, :)
632+
633+
msg = "This message should be deallocated."
634+
635+
allocate(input(12, 5))
636+
call random_number(input)
637+
call save_npy(filename, input, stat, msg)
638+
call delete_file(filename)
639+
640+
call check(error,.not. allocated(msg), "Message wrongly allocated.")
641+
642+
end subroutine
643+
622644
subroutine delete_file(filename)
623645
character(len=*), intent(in) :: filename
624646

0 commit comments

Comments
 (0)