From fb00a48dbc4107432c1c92528d7e6818fda632b2 Mon Sep 17 00:00:00 2001
From: Jacob Williams <jacobwilliams@users.noreply.github.com>
Date: Thu, 20 Feb 2025 16:43:44 -0600
Subject: [PATCH] added some iostat checks to write statements to avoid
 potential crashes

Fixes #581
---
 src/json_value_module.F90 | 28 +++++++++++++++++++++++-----
 1 file changed, 23 insertions(+), 5 deletions(-)

diff --git a/src/json_value_module.F90 b/src/json_value_module.F90
index ce26235c5..f2316645d 100644
--- a/src/json_value_module.F90
+++ b/src/json_value_module.F90
@@ -6120,6 +6120,7 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
 
                 s = s_indent//start_object
                 call write_it()
+                if (json%exception_thrown) return
 
                 !if an object is in an array, there is an extra tab:
                 if (is_array) then
@@ -6150,6 +6151,7 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
                                           str_escaped//quotation_mark//colon_char//space
                             call write_it(advance=.false.)
                         end if
+                        if (json%exception_thrown) return
                     else
                         call json%throw_exception('Error in json_value_print:'//&
                                                   ' element%name not allocated')
@@ -6195,6 +6197,7 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
 
                 s = s_indent//start_array
                 call write_it( advance=(.not. is_vector) )
+                if (json%exception_thrown) return
 
                 !if an array is in an array, there is an extra tab:
                 if (is_array) then
@@ -6223,7 +6226,6 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
                                         need_comma=i<count, is_array_element=.true., &
                                         str=str, iloc=iloc)
                     end if
-                    if (json%exception_thrown) return
 
                     ! get the next child the list:
                     element => element%next
@@ -6311,6 +6313,8 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
 
     end if
 
+    if (json%exception_thrown) return
+
     contains
 
         subroutine write_it(advance,comma,space_after_comma)
@@ -6329,6 +6333,7 @@ subroutine write_it(advance,comma,space_after_comma)
         integer(IK) :: n               !! length of actual string `s` appended to `str`
         integer(IK) :: room_left       !! number of characters left in `str`
         integer(IK) :: n_chunks_to_add !! number of chunks to add to `str` for appending `s`
+        integer(IK) :: istat           !! `iostat` code for `write` statement
 
         if (present(comma)) then
             add_comma = comma
@@ -6368,9 +6373,14 @@ subroutine write_it(advance,comma,space_after_comma)
         if (write_file) then
 
             if (add_line_break) then
-                write(iunit,fmt='(A)') s
+                write(iunit,fmt='(A)',iostat=istat) s
             else
-                write(iunit,fmt='(A)',advance='NO') s
+                write(iunit,fmt='(A)',advance='NO',iostat=istat) s
+            end if
+            if (istat/=0) then
+                call integer_to_string(iunit,int_fmt,tmp)
+                call json%throw_exception('Error in json_value_print: '//&
+                                          'could not write to file unit: '//trim(tmp))
             end if
 
         else    !write string
@@ -11577,6 +11587,8 @@ subroutine json_print_error_message(json,io_unit)
 
     character(kind=CK,len=:),allocatable :: error_msg  !! error message
     logical :: status_ok !! false if there were any errors thrown
+    integer(IK) :: istat !! for write error checking
+    character(kind=CK,len=max_integer_str_len) :: tmp !! for int to string conversions
 
     !get error message:
     call json%check_for_errors(status_ok, error_msg)
@@ -11584,9 +11596,15 @@ subroutine json_print_error_message(json,io_unit)
     !print it if there is one:
     if (.not. status_ok) then
         if (present(io_unit)) then
-            write(io_unit,'(A)') error_msg
+            write(io_unit,'(A)',iostat=istat) error_msg
+            if (istat/=0) then
+                ! in this case, just try to write to the error_unit
+                call integer_to_string(io_unit,int_fmt,tmp)
+                write(error_unit,'(A)',iostat=istat) 'Error writing to unit '//trim(tmp)
+                write(error_unit,'(A)',iostat=istat) error_msg
+            end if
         else
-            write(output_unit,'(A)') error_msg
+            write(output_unit,'(A)',iostat=istat) error_msg
         end if
         deallocate(error_msg)
         call json%clear_exceptions()