@@ -176,7 +176,10 @@ module json_value_module
176
176
! ! when an error is thrown in the class.
177
177
! ! Many of the methods will check this
178
178
! ! and return immediately if it is true.
179
- character (kind= CK,len= :),allocatable :: err_message ! ! the error message
179
+ character (kind= CK,len= :),allocatable :: err_message
180
+ ! ! the error message.
181
+ ! ! if `exception_thrown=False` then
182
+ ! ! this variable is not allocated.
180
183
181
184
integer (IK) :: char_count = 0 ! ! character position in the current line
182
185
integer (IK) :: line_count = 1 ! ! lines read counter
@@ -463,11 +466,11 @@ module json_value_module
463
466
! type(json_core) :: json
464
467
! type(json_value) :: p
465
468
! !...
466
- ! call json%print(p,'test.json') !this is [[json_print_2 ]]
469
+ ! call json%print(p,'test.json') !this is [[json_print_to_filename ]]
467
470
! ````
468
- generic,public :: print = > json_print_1,json_print_2
469
- procedure :: json_print_1
470
- procedure :: json_print_2
471
+ generic,public :: print = > json_print_to_unit,json_print_to_filename
472
+ procedure :: json_print_to_unit
473
+ procedure :: json_print_to_filename
471
474
472
475
! >
473
476
! Destructor routine for a [[json_value]] pointer.
@@ -1804,7 +1807,7 @@ pure subroutine json_clear_exceptions(json)
1804
1807
1805
1808
! clear the flag and message:
1806
1809
json% exception_thrown = .false.
1807
- json% err_message = CK_ ' '
1810
+ if ( allocated ( json% err_message)) deallocate (json % err_message)
1808
1811
1809
1812
end subroutine json_clear_exceptions
1810
1813
! *****************************************************************************************
@@ -1908,25 +1911,27 @@ end subroutine wrap_json_throw_exception
1908
1911
!
1909
1912
! ### See also
1910
1913
! * [[json_failed]]
1914
+ ! * [[json_throw_exception]]
1911
1915
1912
- subroutine json_check_for_errors (json ,status_ok ,error_msg )
1916
+ pure subroutine json_check_for_errors (json ,status_ok ,error_msg )
1913
1917
1914
1918
implicit none
1915
1919
1916
- class(json_core),intent (inout ) :: json
1917
- logical (LK),intent (out ) :: status_ok ! ! true if there were no errors
1918
- character (kind= CK,len= :),allocatable ,intent (out ) :: error_msg ! ! the error message (if there were errors)
1920
+ class(json_core),intent (in ) :: json
1921
+ logical (LK),intent (out ),optional :: status_ok ! ! true if there were no errors
1922
+ character (kind= CK,len= :),allocatable ,intent (out ),optional :: error_msg ! ! the error message.
1923
+ ! ! (not allocated if
1924
+ ! ! there were no errors)
1919
1925
1920
- status_ok = .not. json% exception_thrown
1926
+ if ( present (status_ok)) status_ok = .not. json% exception_thrown
1921
1927
1922
- if (.not. status_ok) then
1923
- if (allocated (json% err_message)) then
1928
+ if (present (error_msg)) then
1929
+ if (json% exception_thrown) then
1930
+ ! if an exception has been thrown,
1931
+ ! then this will always be allocated
1932
+ ! [see json_throw_exception]
1924
1933
error_msg = json% err_message
1925
- else
1926
- error_msg = ' Unknown error.'
1927
1934
end if
1928
- else
1929
- error_msg = CK_' '
1930
1935
end if
1931
1936
1932
1937
end subroutine json_check_for_errors
@@ -5225,7 +5230,7 @@ end subroutine json_value_to_string
5225
5230
!
5226
5231
! Print the [[json_value]] structure to a file.
5227
5232
5228
- subroutine json_print_1 (json ,p ,iunit )
5233
+ subroutine json_print_to_unit (json ,p ,iunit )
5229
5234
5230
5235
implicit none
5231
5236
@@ -5234,15 +5239,16 @@ subroutine json_print_1(json,p,iunit)
5234
5239
integer (IK),intent (in ) :: iunit ! ! the file unit (the file must
5235
5240
! ! already have been opened, can't be -1).
5236
5241
5237
- character (kind= CK,len= :),allocatable :: dummy
5242
+ character (kind= CK,len= :),allocatable :: dummy ! ! dummy for `str` argument
5243
+ ! ! to [[json_value_print]]
5238
5244
5239
5245
if (iunit/= unit2str) then
5240
5246
call json% json_value_print(p,iunit,str= dummy, indent= 1_IK , colon= .true. )
5241
5247
else
5242
- call json% throw_exception(' Error in json_print_1 : iunit must not be -1.' )
5248
+ call json% throw_exception(' Error in json_print_to_unit : iunit must not be -1.' )
5243
5249
end if
5244
5250
5245
- end subroutine json_print_1
5251
+ end subroutine json_print_to_unit
5246
5252
! *****************************************************************************************
5247
5253
5248
5254
! *****************************************************************************************
@@ -5251,7 +5257,7 @@ end subroutine json_print_1
5251
5257
!
5252
5258
! Print the [[json_value]] structure to a file.
5253
5259
5254
- subroutine json_print_2 (json ,p ,filename )
5260
+ subroutine json_print_to_filename (json ,p ,filename )
5255
5261
5256
5262
implicit none
5257
5263
@@ -5260,18 +5266,19 @@ subroutine json_print_2(json,p,filename)
5260
5266
character (kind= CDK,len=* ),intent (in ) :: filename ! ! the filename to print to
5261
5267
! ! (should not already be open)
5262
5268
5263
- integer (IK) :: iunit,istat
5269
+ integer (IK) :: iunit ! ! file unit for `open` statement
5270
+ integer (IK) :: istat ! ! `iostat` code for `open` statement
5264
5271
5265
5272
open (newunit= iunit,file= filename,status= ' REPLACE' ,iostat= istat FILE_ENCODING )
5266
5273
if (istat== 0 ) then
5267
5274
call json% print (p,iunit)
5268
5275
close (iunit,iostat= istat)
5269
5276
else
5270
- call json% throw_exception(' Error in json_print_2 : could not open file: ' // &
5277
+ call json% throw_exception(' Error in json_print_to_filename : could not open file: ' // &
5271
5278
trim (filename))
5272
5279
end if
5273
5280
5274
- end subroutine json_print_2
5281
+ end subroutine json_print_to_filename
5275
5282
! *****************************************************************************************
5276
5283
5277
5284
! *****************************************************************************************
@@ -5291,16 +5298,17 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
5291
5298
5292
5299
class(json_core),intent (inout ) :: json
5293
5300
type (json_value),pointer ,intent (in ) :: p
5294
- integer (IK),intent (in ) :: iunit ! ! file unit to write to (6=console)
5301
+ integer (IK),intent (in ) :: iunit ! ! file unit to write to (the
5302
+ ! ! file is assumed to be open)
5295
5303
integer (IK),intent (in ),optional :: indent ! ! indention level
5296
5304
logical (LK),intent (in ),optional :: is_array_element ! ! if this is an array element
5297
5305
logical (LK),intent (in ),optional :: need_comma ! ! if it needs a comma after it
5298
5306
logical (LK),intent (in ),optional :: colon ! ! if the colon was just written
5299
5307
character (kind= CK,len= :),intent (inout ),allocatable :: str
5300
- ! ! if `iunit==unit2str` (-1) then the structure is
5301
- ! ! printed to this string rather than
5302
- ! ! a file. This mode is used by
5303
- ! ! [[json_value_to_string]].
5308
+ ! ! if `iunit==unit2str` (-1) then
5309
+ ! ! the structure is printed to this
5310
+ ! ! string rather than a file. This mode
5311
+ ! ! is used by [[json_value_to_string]].
5304
5312
logical (LK),intent (in ),optional :: is_compressed_vector ! ! if True, this is an element
5305
5313
! ! from an array being printed
5306
5314
! ! on one line [default is False]
@@ -5326,6 +5334,16 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
5326
5334
5327
5335
if (.not. json% exception_thrown) then
5328
5336
5337
+ if (.not. associated (p)) then
5338
+ ! note: a null() pointer will trigger this error.
5339
+ ! However, if the pointer is undefined, then this will
5340
+ ! crash (if this wasn't here it would crash below when
5341
+ ! we try to access the contents)
5342
+ call json% throw_exception(' Error in json_value_print: ' // &
5343
+ ' the pointer is not associated' )
5344
+ return
5345
+ end if
5346
+
5329
5347
if (present (is_compressed_vector)) then
5330
5348
is_vector = is_compressed_vector
5331
5349
else
@@ -5420,6 +5438,7 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
5420
5438
! recursive print of the element
5421
5439
call json% json_value_print(element, iunit= iunit, indent= tab + 1 , &
5422
5440
need_comma= i< count, colon= .true. , str= str)
5441
+ if (json% exception_thrown) return
5423
5442
5424
5443
! get the next child the list:
5425
5444
element = > element% next
@@ -5500,6 +5519,8 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
5500
5519
call json% json_value_print(element, iunit= iunit, indent= tab,&
5501
5520
need_comma= i< count, is_array_element= .true. , str= str)
5502
5521
end if
5522
+ if (json% exception_thrown) return
5523
+
5503
5524
! get the next child the list:
5504
5525
element = > element% next
5505
5526
@@ -8859,8 +8880,8 @@ subroutine annotate_invalid_json(json,iunit,str)
8859
8880
end if
8860
8881
8861
8882
! create the error message:
8862
- json% err_message = json% err_message// newline// &
8863
- ' line: ' // trim (adjustl (line_str))// ' , ' // &
8883
+ if ( allocated ( json% err_message)) json % err_message = json% err_message// newline
8884
+ json % err_message = ' line: ' // trim (adjustl (line_str))// ' , ' // &
8864
8885
' character: ' // trim (adjustl (char_str))// newline// &
8865
8886
trim (line)// newline// arrow_str
8866
8887
0 commit comments