Attempting to protect against memory leaks when an invalid JSON file is parsed. Added a new test case with an invalid file.

Author: jacobwilliams

files/invalid2.json

@@ -0,0 +1,6 @@
+{
+"notes": "This is an invalid JSON file, used to test error handling.",
+"version": {
+"major": 2,
+"minor": 0,
+"patch": 0,

src/json_example.f90

@@ -70,7 +70,8 @@ program json_test
     call test_3()
     call test_4()
     call test_5()
-    call test_6()
+    
+    call test_6()  !these are attempting to read invalid json files
 
     !call memory_leak_test()    
 
@@ -87,24 +88,33 @@ subroutine test_6()
 !**************************************************************
     implicit none
 
-    type(json_file) :: json   
+    type(json_file) :: json 
+    integer :: i  
+    
+    character(len=*),dimension(2),parameter :: files = ['invalid.json ',&
+                                                        'invalid2.json']
 
     write(*,'(A)') ''
     write(*,'(A)') '================================='
-    write(*,'(A)') '   EXAMPLE 6 : invalid JSON file '
+    write(*,'(A)') '   EXAMPLE 6 : invalid JSON files'
     write(*,'(A)') '================================='
     write(*,'(A)') ''
 
-    ! parse the json file:
-    write(*,'(A)') 'load file...'
-    call json%load_file(filename = dir//'invalid.json')
-    if (json_failed()) then
-        call print_error_message()
-    end if
-
-    ! clean up
-    call json%destroy()
+    do i=1,2
+    
+        ! parse the json file:
+        write(*,'(A)') ''
+        write(*,'(A)') 'load file: '//trim(files(i))
+        write(*,'(A)') ''
+        call json%load_file(filename = dir//trim(files(i)))
+        if (json_failed()) then
+            call print_error_message()
+        end if
+        ! clean up
+        call json%destroy()
 
+    end do
+    
 !**************************************************************
     end subroutine test_6
 !**************************************************************
@@ -641,7 +651,7 @@ subroutine test_1()
 
         !call json%get('data(2)', p)
         !call json_update(p,'real',[1.0_wp, 2.0_wp, 3.0_wp],found)   !don't have one like this yet...
-		
+        
         write(*,'(A)') ''
         write(*,'(A)') 'printing the modified structure...'
         call json%print_file()       

src/json_module.f90

@@ -4098,21 +4098,21 @@ recursive subroutine parse_object(unit, parent)
         if (eof) then
             call throw_exception('Error in parse_object:'//&
                                  ' Unexpected end of file while parsing start of object.')
-            call cleanup()
             return
         else if ('}' == c) then
             ! end of an empty object
-            call cleanup()
             return
         else if ('"' == c) then
             call json_value_create(pair)
             call parse_string(unit, tmp)   !write to a tmp variable because of
             pair % name = tmp              ! a bug in 4.9 gfortran compiler.
             deallocate(tmp)
-            if (exception_thrown) return
+            if (exception_thrown) then
+                call json_destroy(pair)
+                return
+            end if
         else
             call throw_exception('Error in parse_object: Expecting string: "'//c//'"')
-            call cleanup()
             return
         end if
 
@@ -4121,52 +4121,41 @@ recursive subroutine parse_object(unit, parent)
         if (eof) then
             call throw_exception('Error in parse_object:'//&
                                  ' Unexpected end of file while parsing object member.')
-            call cleanup()
             return
         else if (':' == c) then
             ! parse the value
             call parse_value(unit, pair)
-            if (exception_thrown) return
-            call json_value_add(parent, pair)
+            if (exception_thrown) then
+                call json_destroy(pair)
+                return
+            else
+                call json_value_add(parent, pair)
+            end if
         else
             call throw_exception('Error in parse_object:'//&
                                  ' Expecting : and then a value: '//c)
-            call cleanup()
             return
         end if
 
         ! another possible pair
         c = pop_char(unit, eof = eof, skip_ws = .true.)
         if (eof) then
-            call cleanup()
+            call throw_exception('Error in parse_object: '//&
+                                 'End of file encountered when parsing an object')            
             return
         else if (',' == c) then
             ! read the next member
             call parse_object(unit = unit, parent = parent)
         else if ('}' == c) then
-            call cleanup()
+            ! end of object
             return
         else
             call throw_exception('Error in parse_object: Expecting end of object: '//c)
-            call cleanup()
             return
         end if
 
-        call cleanup()
-
     end if
 
-    contains
-
-        !cleanup routine:
-        subroutine cleanup()
-        
-        implicit none
-
-        if (associated(pair)) nullify(pair)
-
-        end subroutine cleanup
-
     end subroutine parse_object
 !*****************************************************************************************
 
@@ -4200,8 +4189,11 @@ subroutine parse_array(unit, array)
         nullify(element)
         call json_value_create(element)
         call parse_value(unit, element)
-        if (exception_thrown) exit
-
+        if (exception_thrown) then
+            if (associated(element)) call json_destroy(element)
+            exit
+        end if
+        
         ! parse value will disassociate an empty array value
         if (associated(element)) call json_value_add(array, element)