@@ -294,6 +294,8 @@ end subroutine array_callback_func
294
294
logical ,parameter :: print_tracebacks = .false. ! used when debugging
295
295
296
296
! POP/PUSH CHARACTER [private variables]
297
+ integer :: char_count = 0
298
+ integer :: line_count = 1
297
299
integer :: pushed_index = 0
298
300
character (len = 10 ) :: pushed_char ! JW : what is this magic number 10??
299
301
@@ -318,6 +320,7 @@ subroutine destroy_json_data_non_polymorphic(me)
318
320
! Jacob Williams
319
321
!
320
322
! ********************************************************************************
323
+
321
324
implicit none
322
325
323
326
class(json_data_non_polymorphic),intent (inout ) :: me
@@ -833,6 +836,8 @@ subroutine json_initialize()
833
836
! Just in case, clear these global variables also:
834
837
pushed_index = 0
835
838
pushed_char = ' '
839
+ char_count = 0
840
+ line_count = 1
836
841
837
842
! ********************************************************************************
838
843
end subroutine json_initialize
@@ -992,7 +997,7 @@ subroutine json_value_create(p)
992
997
!
993
998
! NOTES
994
999
! This routine does not check for exceptions.
995
- ! The pointer should not already be allocated.
1000
+ ! The pointer should not already be allocated.
996
1001
!
997
1002
! ********************************************************************************
998
1003
@@ -2972,7 +2977,8 @@ subroutine json_parse(file, p)
2972
2977
type (json_value),pointer :: p
2973
2978
2974
2979
integer :: iunit, istat
2975
- character (len= :),allocatable :: line
2980
+ character (len= :),allocatable :: line, arrow_str
2981
+ character (len= 10 ) :: line_str, char_str
2976
2982
2977
2983
! clean any exceptions and initialize:
2978
2984
call json_initialize()
@@ -2998,21 +3004,33 @@ subroutine json_parse(file, p)
2998
3004
call parse_value(unit = iunit, value = p)
2999
3005
3000
3006
!
3001
- ! If there was an error reading the file, then see if we
3007
+ ! If there was an error reading the file, then
3002
3008
! can print the line where the error occurred:
3003
3009
!
3004
3010
if (exception_thrown) then
3011
+
3005
3012
call get_current_line_from_file(iunit,line)
3006
- if (istat== 0 ) err_message = err_message// newline// &
3007
- ' Offending line: ' // trim (line)
3013
+
3014
+ ! the counters for the current line and the last character read:
3015
+ call integer_to_string(line_count, line_str)
3016
+ call integer_to_string(char_count, char_str)
3017
+
3018
+ ! draw the arrow string that points to the current character:
3019
+ arrow_str = repeat (' -' ,max ( 0 , char_count - 1 ) )// ' ^'
3020
+
3021
+ ! create the error message:
3022
+ err_message = err_message// newline// &
3023
+ ' line: ' // trim (adjustl (line_str))// ' , ' // &
3024
+ ' character: ' // trim (adjustl (char_str))// newline// &
3025
+ trim (line)// newline// arrow_str
3026
+
3008
3027
if (allocated (line)) deallocate (line)
3028
+
3009
3029
end if
3010
3030
3011
3031
! close the file
3012
3032
close (iunit, iostat= istat)
3013
3033
3014
- if (istat/= 0 ) call throw_exception(' Error in json_parse: Error closing file: ' // trim (file))
3015
-
3016
3034
else
3017
3035
3018
3036
call throw_exception(' Error in json_parse: Error opening file: ' // trim (file))
@@ -3836,13 +3854,17 @@ recursive function pop_char(unit, eof, skip_ws) result(popped)
3836
3854
else
3837
3855
3838
3856
read (unit = unit, fmt = ' (A)' , advance = ' NO' , iostat = ios) c
3857
+ char_count = char_count + 1 ! character count in the current line
3839
3858
3840
3859
if (IS_IOSTAT_EOR(ios)) then ! JW : use intrinsic
3841
3860
3861
+ char_count = 0
3862
+ line_count = line_count + 1
3842
3863
cycle
3843
3864
3844
3865
else if (IS_IOSTAT_END(ios)) then ! JW : use intrinsic
3845
3866
3867
+ char_count = 0
3846
3868
eof = .true.
3847
3869
exit
3848
3870
@@ -3870,8 +3892,6 @@ recursive function pop_char(unit, eof, skip_ws) result(popped)
3870
3892
3871
3893
end if
3872
3894
3873
- ! write(*,'(A)') 'pop_char: '//popped
3874
-
3875
3895
! ********************************************************************************
3876
3896
end function pop_char
3877
3897
! ********************************************************************************
@@ -3934,16 +3954,12 @@ subroutine integer_to_string(ival,str)
3934
3954
3935
3955
integer :: istat
3936
3956
3937
- if (.not. exception_thrown) then
3938
-
3939
- write (str,fmt= int_fmt,iostat= istat) ival
3940
-
3941
- if (istat== 0 ) then
3942
- str = adjustl (str)
3943
- else
3944
- call throw_exception(' Error in integer_to_string: invalid value.' )
3945
- end if
3957
+ write (str,fmt= int_fmt,iostat= istat) ival
3946
3958
3959
+ if (istat== 0 ) then
3960
+ str = adjustl (str)
3961
+ else
3962
+ str = repeat (' *' ,len (str))
3947
3963
end if
3948
3964
3949
3965
! ********************************************************************************
@@ -3972,16 +3988,12 @@ subroutine real_to_string(rval,str)
3972
3988
3973
3989
integer :: istat
3974
3990
3975
- if (.not. exception_thrown) then
3976
-
3977
- write (str,fmt= real_fmt,iostat= istat) rval
3978
-
3979
- if (istat== 0 ) then
3980
- str = adjustl (str)
3981
- else
3982
- call throw_exception(' Error in real_to_string: invalid value.' )
3983
- end if
3991
+ write (str,fmt= real_fmt,iostat= istat) rval
3984
3992
3993
+ if (istat== 0 ) then
3994
+ str = adjustl (str)
3995
+ else
3996
+ str = repeat (' *' ,len (str))
3985
3997
end if
3986
3998
3987
3999
! ********************************************************************************
0 commit comments