Fixed bug in invalid annotate routine. Added a unit test to test this. Fixes #355

Reverted an inadvertent regression in the previous commit.
The arguments to json_file_check_for_errors are now optional to match the core routine. Fixes #356
Added some workaround in the error checking routine to gfortran bugs.

Author: jacobwilliams

files/inputs/invalid3.json

@@ -0,0 +1,4 @@
+{
+"a": "blah\",
+"b": 2
+}

files/inputs/test1.json

@@ -12,7 +12,8 @@
 		"..\\path\\to\\files\\file3.txt",
 		"test \u2FA4 \uABCD \uABCD\uABCDtest",
 		"   test  \\u \" blah\\\" test test",
-		"..\\path\\to\\files\\"
+		"..\\path\\to\\files\\",
+		"\\"
 	],
     "a": {
         "b": 1

src/json_file_module.F90

@@ -320,10 +320,17 @@ subroutine json_file_check_for_errors(me,status_ok,error_msg)
     implicit none
 
     class(json_file),intent(inout) :: me
-    logical(LK),intent(out) :: status_ok !! true if there were no errors
-    character(kind=CK,len=:),allocatable,intent(out) :: error_msg !! the error message (if there were errors)
-
+    logical(LK),intent(out),optional :: status_ok !! true if there were no errors
+    character(kind=CK,len=:),allocatable,intent(out),optional :: error_msg !! the error message
+                                                                           !! (if there were errors)
+
+#if defined __GFORTRAN__
+    character(kind=CK,len=:),allocatable :: tmp  !! workaround for gfortran bugs
+    call me%core%check_for_errors(status_ok,tmp)
+    error_msg = tmp
+#else
     call me%core%check_for_errors(status_ok,error_msg)
+#endif
 
     end subroutine json_file_check_for_errors
 !*****************************************************************************************

src/json_value_module.F90

@@ -1917,7 +1917,7 @@ end subroutine wrap_json_throw_exception
 !  * [[json_failed]]
 !  * [[json_throw_exception]]
 
-    pure subroutine json_check_for_errors(json,status_ok,error_msg)
+    subroutine json_check_for_errors(json,status_ok,error_msg)
 
     implicit none
 
@@ -1927,14 +1927,23 @@ pure subroutine json_check_for_errors(json,status_ok,error_msg)
                                                                            !! (not allocated if
                                                                            !! there were no errors)
 
+#if defined __GFORTRAN__
+    character(kind=CK,len=:),allocatable :: tmp  !! workaround for gfortran bugs
+#endif
+
     if (present(status_ok)) status_ok = .not. json%exception_thrown
 
     if (present(error_msg)) then
         if (json%exception_thrown) then
             ! if an exception has been thrown,
             ! then this will always be allocated
             ! [see json_throw_exception]
+#if defined __GFORTRAN__
+            tmp = json%err_message
+            error_msg = tmp
+#else
             error_msg = json%err_message
+#endif
         end if
     end if
 
@@ -8752,12 +8761,9 @@ subroutine json_parse_file(json, file, p, unit)
         !  but we'll allocate something here just in case.
         p%name = trim(file)  !use the file name
 
-            ! parse as a value
+        ! parse as a value
         call json%parse_value(unit=iunit, str=CK_'', value=p)
 
-            ! close the file if necessary
-            close(unit=iunit, iostat=istat)
-
         ! check for errors:
         if (json%exception_thrown) then
             call json%annotate_invalid_json(iunit,CK_'')
@@ -8773,6 +8779,9 @@ subroutine json_parse_file(json, file, p, unit)
             end if
         end if
 
+        ! close the file:
+        close(unit=iunit, iostat=istat)
+
     else
 
         call json%throw_exception('Error in json_parse_file: Error opening file: '//trim(file))
@@ -8872,8 +8881,8 @@ subroutine annotate_invalid_json(json,iunit,str)
     integer(IK) :: i_nl_prev  !! index of previous newline character
     integer(IK) :: i_nl       !! index of current newline character
 
-    !  If there was an error reading the file, then
-    !   print the line where the error occurred:
+    ! If there was an error reading the file, then
+    ! print the line where the error occurred:
     if (json%exception_thrown) then
 
         !the counters for the current line and the last character read:
@@ -8918,8 +8927,13 @@ subroutine annotate_invalid_json(json,iunit,str)
         end if
 
         !create the error message:
-        if (allocated(json%err_message)) json%err_message = json%err_message//newline
-        json%err_message = 'line: '//trim(adjustl(line_str))//', '//&
+        if (allocated(json%err_message)) then
+            json%err_message = json%err_message//newline
+        else
+            json%err_message = ''
+        end if
+        json%err_message = json%err_message//&
+                           'line: '//trim(adjustl(line_str))//', '//&
                            'character: '//trim(adjustl(char_str))//newline//&
                            trim(line)//newline//arrow_str
 
@@ -9883,6 +9897,7 @@ subroutine parse_string(json, unit, str, string)
                                                                !! if necessary)
 
     logical(LK)              :: eof      !! end of file flag
+    logical(LK)              :: escape   !! for escape string parsing
     character(kind=CK,len=1) :: c        !! character returned by [[pop_char]]
     integer(IK)              :: ip       !! index to put next character,
                                          !! to speed up by reducing the number
@@ -9895,7 +9910,8 @@ subroutine parse_string(json, unit, str, string)
     if (.not. json%exception_thrown) then
 
         !initialize:
-        ip = 1
+        escape = .false.
+        ip     = 1
 
         do
 
@@ -9907,7 +9923,7 @@ subroutine parse_string(json, unit, str, string)
                 call json%throw_exception('Error in parse_string: Expecting end of string')
                 return
 
-            else if (c==quotation_mark) then  !end of string
+            else if (c==quotation_mark .and. .not. escape) then  !end of string
 
                 exit
 
@@ -9920,6 +9936,15 @@ subroutine parse_string(json, unit, str, string)
                 string(ip:ip) = c
                 ip = ip + 1
 
+                ! check for escape character, so we don't
+                ! exit prematurely if escaping a quotation
+                ! character:
+                if (escape) then
+                    escape = .false.
+                else
+                    escape = (c==backslash)
+                end if
+
             end if
 
         end do

src/tests/jf_test_06.F90

@@ -7,7 +7,8 @@
 
 module jf_test_6_mod
 
-    use json_module
+    use json_module, CK => json_CK, LK => json_LK
+    use json_parameters, only: newline
     use, intrinsic :: iso_fortran_env , only: error_unit, output_unit, wp => real64
 
     implicit none
@@ -29,9 +30,12 @@ subroutine test_6(error_cnt)
 
     type(json_file) :: json
     integer :: i
+    character(kind=CK,len=:),allocatable :: error_msg
+    logical(LK) :: status_ok
 
-    character(len=*),dimension(2),parameter :: files = ['invalid.json ',&
-                                                        'invalid2.json']
+    character(len=*),dimension(3),parameter :: files = ['invalid.json ',&
+                                                        'invalid2.json',&
+                                                        'invalid3.json']
 
     error_cnt = 0
     call json%initialize()
@@ -46,15 +50,32 @@ subroutine test_6(error_cnt)
     write(error_unit,'(A)') '================================='
     write(error_unit,'(A)') ''
 
-    do i=1,2
+    do i=1,size(files)
 
         ! parse the json file:
         write(error_unit,'(A)') ''
         write(error_unit,'(A)') 'load file: '//trim(files(i))
         write(error_unit,'(A)') ''
         call json%load_file(filename = dir//trim(files(i)))
         if (json%failed()) then
+
+            if (i==1) then
+                call json%check_for_errors(status_ok, error_msg=error_msg)
+
+                if (error_msg /= &
+                        CK_'Error in parse_array: Unexpected character encountered when parsing array.'//newline//&
+                        CK_'line: 13, character: 1'//newline//&
+                        CK_'}'//newline//&
+                        ''//newline//&
+                        '^') then
+                    ! verify that the expected error string is present
+                    write(error_unit,'(A)') 'Error: unexpected error message string: "'//error_msg//'"'
+                    error_cnt = error_cnt + 1
+                end if
+            end if
+
             call json%print_error_message(error_unit)
+
         else
             write(error_unit,'(A)') 'An error should have been raised!'
             error_cnt = error_cnt + 1

src/tests/jf_test_10.F90

@@ -144,7 +144,7 @@ subroutine test_10(error_cnt)
         error_cnt = error_cnt + 1
     else
         !also make sure the values are correct:
-        if (found .and. size(str_vec)==6 .and. &
+        if (found .and. size(str_vec)==7 .and. &
             str_vec(1)=='..\path\to\files\file1.txt') then
             write(error_unit,'(A)') '...success'
         else
@@ -303,7 +303,7 @@ subroutine test_10(error_cnt)
         error_cnt = error_cnt + 1
     else
         !also make sure the values are correct:
-        if (found .and. size(str_vec)==6 .and. &
+        if (found .and. size(str_vec)==7 .and. &
             str_vec(1)=='..\path\to\files\file1.txt') then
             write(error_unit,'(A)') '...success'
         else