Merge pull request #495 from jacobwilliams/494-memory-issues

Fixing some memory issues in the unit tests

Author: jacobwilliams

src/json_value_module.F90

@@ -10064,6 +10064,7 @@ subroutine get_current_line_from_file_stream(json,iunit,line)
     integer(IK)              :: iend    !! end position of current line
     integer(IK)              :: ios     !! file read `iostat` code
     character(kind=CK,len=1) :: c       !! a character read from the file
+    logical                  :: done    !! flag to exit the loop
 
     istart = json%ipos
     do
@@ -10072,7 +10073,9 @@ subroutine get_current_line_from_file_stream(json,iunit,line)
             exit
         end if
         read(iunit,pos=istart,iostat=ios) c
-        if (c==newline .or. ios/=0) then
+        done = ios /= 0_IK
+        if (.not. done) done = c==newline
+        if (done) then
             if (istart/=1) istart = istart - 1
             exit
         end if
@@ -10895,7 +10898,7 @@ recursive subroutine parse_object(json, unit, str, parent)
                             skip_comments=json%allow_comments, popped=c)
         if (eof) then
             call json%throw_exception('Error in parse_object:'//&
-                                 ' Unexpected end of file while parsing start of object.')
+                                      ' Unexpected end of file while parsing start of object.')
             return
         else if (end_object == c) then
             ! end of an empty object
@@ -10922,8 +10925,9 @@ recursive subroutine parse_object(json, unit, str, parent)
         call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., &
                             skip_comments=json%allow_comments, popped=c)
         if (eof) then
+            call json%destroy(pair)
             call json%throw_exception('Error in parse_object:'//&
-                                 ' Unexpected end of file while parsing object member.')
+                                      ' Unexpected end of file while parsing object member.')
             return
         else if (colon_char == c) then
             ! parse the value
@@ -10935,6 +10939,7 @@ recursive subroutine parse_object(json, unit, str, parent)
                 call json%add(parent, pair)
             end if
         else
+            call json%destroy(pair)
             call json%throw_exception('Error in parse_object:'//&
                                       ' Expecting : and then a value: '//c)
             return
@@ -10945,7 +10950,7 @@ recursive subroutine parse_object(json, unit, str, parent)
                             skip_comments=json%allow_comments, popped=c)
         if (eof) then
             call json%throw_exception('Error in parse_object: '//&
-                                 'End of file encountered when parsing an object')
+                                      'End of file encountered when parsing an object')
             return
         else if (delimiter == c) then
             ! read the next member

src/tests/jf_test_02.F90

@@ -335,6 +335,11 @@ subroutine test_2(error_cnt)
         call json%print_error_message(error_unit)
         error_cnt = error_cnt + 1
     end if
+    call json%destroy(p_clone)
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
 
     write(error_unit,'(A)') ''
 

src/tests/jf_test_10.F90

@@ -321,7 +321,8 @@ subroutine test_10(error_cnt)
     write(error_unit,'(A)') 'json_create_real   ...'; call json%destroy(p); call json%create_real   (p,9.0_wp,'foo')
     write(error_unit,'(A)') 'json_create_string ...'; call json%destroy(p); call json%create_string (p,'foo','bar')
     write(error_unit,'(A)') 'json_create_null   ...'; call json%destroy(p); call json%create_null   (p,'foo')
-    write(error_unit,'(A)') 'json_create_object ...'; call json%destroy(p); call json%create_object (p,'foo')
+    write(error_unit,'(A)') 'json_create_object ...'; call json%destroy(p); call json%create_object (p,'foo')
+    call json%destroy(p)
     if (json%failed()) then
         call json%print_error_message(error_unit)
         error_cnt = error_cnt + 1

src/tests/jf_test_12.F90

@@ -14,10 +14,6 @@ module jf_test_12_mod
     private
     public :: test_12
 
-    character(len=*),parameter :: dir = '../files/'         !! Path to write JSON file to
-    character(len=*),parameter :: file = 'test12.json'      !! Filename to write
-    real(wp), parameter        :: TOL = 100*epsilon(1.0_wp) !! Tolerance for real comparisons
-
 contains
 
     subroutine test_12(error_cnt)
@@ -27,6 +23,8 @@ subroutine test_12(error_cnt)
     integer,intent(out) :: error_cnt !! report number of errors to caller
 
     integer(IK),parameter :: imx = 5, jmx = 3, kmx = 4 !! dimensions for raw work array of primitive type
+    character(len=*),parameter :: file = '../files/test12.json'  !! Filename to write
+    real(wp), parameter        :: TOL = 100*epsilon(1.0_wp) !! Tolerance for real comparisons
 
     type(json_core)                        :: json              !! factory for manipulating `json_value` pointers
     integer(IK),dimension(3)               :: shape             !! shape of work array
@@ -54,11 +52,11 @@ subroutine test_12(error_cnt)
     write(error_unit,'(A)') ''
 
     ! populate the raw array
-    forall (i=1_IK:imx,j=1_IK:jmx,k=1_IK:kmx) ! could use size(... , dim=...) instead of constants
+    do concurrent (i=1_IK:imx, j=1_IK:jmx, k=1_IK:kmx) ! could use size(... , dim=...) instead of constants
        raw_array(i,j,k) = i + (j-1_IK)*imx + (k-1_IK)*imx*jmx
-    end forall
+    end do
 
-    call json%create_object(root,dir//file)
+    call json%create_object(root,file)
     call check_errors()
 
     call json%create_object(meta_array,'array data')
@@ -172,7 +170,7 @@ subroutine test_12(error_cnt)
    !  call my_file%get(tmp_json_ptr)
    !  call check_file_errors(associated(tmp_json_ptr,root))
 
-    open(file=dir//file,newunit=lun,form='formatted',action='write')
+    open(file=file,newunit=lun,form='formatted',action='write')
     call my_file%print(lun)
     call check_file_errors()
     close(lun)

src/tests/jf_test_14.F90

@@ -113,6 +113,8 @@ subroutine test_14(error_cnt)
         error_cnt = error_cnt + 1
     end if
 
+    if (allocated(new_name)) deallocate(new_name)
+
     end subroutine test_14
 
     subroutine rename(json,p,finished)  !! change all "name" variable values to "Fred"

src/tests/jf_test_20.F90

@@ -183,6 +183,7 @@ subroutine test_20(error_cnt)
 
     ! cleanup:
     call json%destroy(p)
+    call json%destroy(root)
 
     ! now, just a test of the edge case:
     ! (where p doesn't have a parent)

src/tests/jf_test_34.F90

@@ -141,6 +141,7 @@ subroutine test_34(error_cnt)
     call json%initialize(trailing_spaces_significant=.true.)
     call json%create_integer(p,1_IK,CK_'a')
     call json%rename(p,CK_'b  ')
+    call json%destroy(p)
 
     end subroutine test_34
 

src/tests/jf_test_35.F90

@@ -23,7 +23,7 @@ subroutine test_35(error_cnt)
     integer,intent(out) :: error_cnt
 
     type(json_core) :: json
-    type(json_value),pointer :: p_root,p_array
+    type(json_value),pointer :: p_root,p_array,p_element
     logical(LK) :: is_valid  !! True if the structure is valid.
     character(kind=CK,len=:),allocatable :: error_msg !! error message from `validate`
     integer :: i !! counter
@@ -47,12 +47,11 @@ subroutine test_35(error_cnt)
             call json%add(p_root,p_array)
             call json%add(p_root,p_array)  ! this creates a malformed JSON structure
         elseif (i==2) then
-            call json%create_array(p_array, '')
-            call json%create_object(p_root, 'object')
-            call json%add(p_root,'int',1_IK)
-            call json%add(p_array,p_root)
-            call json%add(p_array,p_root)  ! this creates a malformed JSON structure
-            ! note: below we will destroy p_root, which is the duplicate array element
+            call json%create_array(p_root, '')
+            call json%create_object(p_element, 'object')
+            call json%add(p_element,'int',1_IK)
+            call json%add(p_root,p_element)
+            call json%add(p_root,p_element)  ! this creates a malformed JSON structure
         end if
 
         ! test initialize_json_core:

src/tests/jf_test_44.F90

@@ -52,6 +52,8 @@ subroutine test_44(error_cnt)
         error_cnt = error_cnt + 1
     end if
 
+    call json%destroy(p)
+
     if (error_cnt==0) then
         write(error_unit,'(A)') 'Success!'
     else

src/tests/jf_test_47.F90

@@ -117,6 +117,8 @@ subroutine test_47(error_cnt)
 
     end if
 
+    call json%destroy(inp)
+
     write(error_unit,'(A)') ''
     if (error_cnt==0) then
         write(error_unit,'(A)') 'Success!'