@@ -6120,6 +6120,7 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
6120
6120
6121
6121
s = s_indent// start_object
6122
6122
call write_it()
6123
+ if (json% exception_thrown) return
6123
6124
6124
6125
! if an object is in an array, there is an extra tab:
6125
6126
if (is_array) then
@@ -6150,6 +6151,7 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
6150
6151
str_escaped// quotation_mark// colon_char// space
6151
6152
call write_it(advance= .false. )
6152
6153
end if
6154
+ if (json% exception_thrown) return
6153
6155
else
6154
6156
call json% throw_exception(' Error in json_value_print:' // &
6155
6157
' element%name not allocated' )
@@ -6195,6 +6197,7 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
6195
6197
6196
6198
s = s_indent// start_array
6197
6199
call write_it( advance= (.not. is_vector) )
6200
+ if (json% exception_thrown) return
6198
6201
6199
6202
! if an array is in an array, there is an extra tab:
6200
6203
if (is_array) then
@@ -6223,7 +6226,6 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
6223
6226
need_comma= i< count, is_array_element= .true. , &
6224
6227
str= str, iloc= iloc)
6225
6228
end if
6226
- if (json% exception_thrown) return
6227
6229
6228
6230
! get the next child the list:
6229
6231
element = > element% next
@@ -6311,6 +6313,8 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
6311
6313
6312
6314
end if
6313
6315
6316
+ if (json% exception_thrown) return
6317
+
6314
6318
contains
6315
6319
6316
6320
subroutine write_it (advance ,comma ,space_after_comma )
@@ -6329,6 +6333,7 @@ subroutine write_it(advance,comma,space_after_comma)
6329
6333
integer (IK) :: n ! ! length of actual string `s` appended to `str`
6330
6334
integer (IK) :: room_left ! ! number of characters left in `str`
6331
6335
integer (IK) :: n_chunks_to_add ! ! number of chunks to add to `str` for appending `s`
6336
+ integer (IK) :: istat ! ! `iostat` code for `write` statement
6332
6337
6333
6338
if (present (comma)) then
6334
6339
add_comma = comma
@@ -6368,9 +6373,14 @@ subroutine write_it(advance,comma,space_after_comma)
6368
6373
if (write_file) then
6369
6374
6370
6375
if (add_line_break) then
6371
- write (iunit,fmt= ' (A)' ) s
6376
+ write (iunit,fmt= ' (A)' ,iostat = istat ) s
6372
6377
else
6373
- write (iunit,fmt= ' (A)' ,advance= ' NO' ) s
6378
+ write (iunit,fmt= ' (A)' ,advance= ' NO' ,iostat= istat) s
6379
+ end if
6380
+ if (istat/= 0 ) then
6381
+ call integer_to_string(iunit,int_fmt,tmp)
6382
+ call json% throw_exception(' Error in json_value_print: ' // &
6383
+ ' could not write to file unit: ' // trim (tmp))
6374
6384
end if
6375
6385
6376
6386
else ! write string
@@ -11577,16 +11587,24 @@ subroutine json_print_error_message(json,io_unit)
11577
11587
11578
11588
character (kind= CK,len= :),allocatable :: error_msg ! ! error message
11579
11589
logical :: status_ok ! ! false if there were any errors thrown
11590
+ integer (IK) :: istat ! ! for write error checking
11591
+ character (kind= CK,len= max_integer_str_len) :: tmp ! ! for int to string conversions
11580
11592
11581
11593
! get error message:
11582
11594
call json% check_for_errors(status_ok, error_msg)
11583
11595
11584
11596
! print it if there is one:
11585
11597
if (.not. status_ok) then
11586
11598
if (present (io_unit)) then
11587
- write (io_unit,' (A)' ) error_msg
11599
+ write (io_unit,' (A)' ,iostat= istat) error_msg
11600
+ if (istat/= 0 ) then
11601
+ ! in this case, just try to write to the error_unit
11602
+ call integer_to_string(io_unit,int_fmt,tmp)
11603
+ write (error_unit,' (A)' ,iostat= istat) ' Error writing to unit ' // trim (tmp)
11604
+ write (error_unit,' (A)' ,iostat= istat) error_msg
11605
+ end if
11588
11606
else
11589
- write (output_unit,' (A)' ) error_msg
11607
+ write (output_unit,' (A)' ,iostat = istat ) error_msg
11590
11608
end if
11591
11609
deallocate (error_msg)
11592
11610
call json% clear_exceptions()
0 commit comments