Skip to content

Commit 4c38d6f

Browse files
jacobwilliamsjacobwilliams
authored
Merge pull request #495 from jacobwilliams/494-memory-issues
Fixing some memory issues in the unit tests
2 parents f5078a4 + 23d98f6 commit 4c38d6f

12 files changed

+40
-24
lines changed

‎src/json_value_module.F90

+9-4
Original file line numberDiff line numberDiff line change
@@ -10064,6 +10064,7 @@ subroutine get_current_line_from_file_stream(json,iunit,line)
1006410064
integer(IK) :: iend !! end position of current line
1006510065
integer(IK) :: ios !! file read `iostat` code
1006610066
character(kind=CK,len=1) :: c !! a character read from the file
10067+
logical :: done !! flag to exit the loop
1006710068

1006810069
istart = json%ipos
1006910070
do
@@ -10072,7 +10073,9 @@ subroutine get_current_line_from_file_stream(json,iunit,line)
1007210073
exit
1007310074
end if
1007410075
read(iunit,pos=istart,iostat=ios) c
10075-
if (c==newline .or. ios/=0) then
10076+
done = ios /= 0_IK
10077+
if (.not. done) done = c==newline
10078+
if (done) then
1007610079
if (istart/=1) istart = istart - 1
1007710080
exit
1007810081
end if
@@ -10895,7 +10898,7 @@ recursive subroutine parse_object(json, unit, str, parent)
1089510898
skip_comments=json%allow_comments, popped=c)
1089610899
if (eof) then
1089710900
call json%throw_exception('Error in parse_object:'//&
10898-
' Unexpected end of file while parsing start of object.')
10901+
' Unexpected end of file while parsing start of object.')
1089910902
return
1090010903
else if (end_object == c) then
1090110904
! end of an empty object
@@ -10922,8 +10925,9 @@ recursive subroutine parse_object(json, unit, str, parent)
1092210925
call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., &
1092310926
skip_comments=json%allow_comments, popped=c)
1092410927
if (eof) then
10928+
call json%destroy(pair)
1092510929
call json%throw_exception('Error in parse_object:'//&
10926-
' Unexpected end of file while parsing object member.')
10930+
' Unexpected end of file while parsing object member.')
1092710931
return
1092810932
else if (colon_char == c) then
1092910933
! parse the value
@@ -10935,6 +10939,7 @@ recursive subroutine parse_object(json, unit, str, parent)
1093510939
call json%add(parent, pair)
1093610940
end if
1093710941
else
10942+
call json%destroy(pair)
1093810943
call json%throw_exception('Error in parse_object:'//&
1093910944
' Expecting : and then a value: '//c)
1094010945
return
@@ -10945,7 +10950,7 @@ recursive subroutine parse_object(json, unit, str, parent)
1094510950
skip_comments=json%allow_comments, popped=c)
1094610951
if (eof) then
1094710952
call json%throw_exception('Error in parse_object: '//&
10948-
'End of file encountered when parsing an object')
10953+
'End of file encountered when parsing an object')
1094910954
return
1095010955
else if (delimiter == c) then
1095110956
! read the next member

‎src/tests/jf_test_02.F90

+5
Original file line numberDiff line numberDiff line change
@@ -335,6 +335,11 @@ subroutine test_2(error_cnt)
335335
call json%print_error_message(error_unit)
336336
error_cnt = error_cnt + 1
337337
end if
338+
call json%destroy(p_clone)
339+
if (json%failed()) then
340+
call json%print_error_message(error_unit)
341+
error_cnt = error_cnt + 1
342+
end if
338343

339344
write(error_unit,'(A)') ''
340345

‎src/tests/jf_test_10.F90

+2-1
Original file line numberDiff line numberDiff line change
@@ -321,7 +321,8 @@ subroutine test_10(error_cnt)
321321
write(error_unit,'(A)') 'json_create_real ...'; call json%destroy(p); call json%create_real (p,9.0_wp,'foo')
322322
write(error_unit,'(A)') 'json_create_string ...'; call json%destroy(p); call json%create_string (p,'foo','bar')
323323
write(error_unit,'(A)') 'json_create_null ...'; call json%destroy(p); call json%create_null (p,'foo')
324-
write(error_unit,'(A)') 'json_create_object ...'; call json%destroy(p); call json%create_object (p,'foo')
324+
write(error_unit,'(A)') 'json_create_object ...'; call json%destroy(p); call json%create_object (p,'foo')
325+
call json%destroy(p)
325326
if (json%failed()) then
326327
call json%print_error_message(error_unit)
327328
error_cnt = error_cnt + 1

‎src/tests/jf_test_12.F90

+6-8
Original file line numberDiff line numberDiff line change
@@ -14,10 +14,6 @@ module jf_test_12_mod
1414
private
1515
public :: test_12
1616

17-
character(len=*),parameter :: dir = '../files/' !! Path to write JSON file to
18-
character(len=*),parameter :: file = 'test12.json' !! Filename to write
19-
real(wp), parameter :: TOL = 100*epsilon(1.0_wp) !! Tolerance for real comparisons
20-
2117
contains
2218

2319
subroutine test_12(error_cnt)
@@ -27,6 +23,8 @@ subroutine test_12(error_cnt)
2723
integer,intent(out) :: error_cnt !! report number of errors to caller
2824

2925
integer(IK),parameter :: imx = 5, jmx = 3, kmx = 4 !! dimensions for raw work array of primitive type
26+
character(len=*),parameter :: file = '../files/test12.json' !! Filename to write
27+
real(wp), parameter :: TOL = 100*epsilon(1.0_wp) !! Tolerance for real comparisons
3028

3129
type(json_core) :: json !! factory for manipulating `json_value` pointers
3230
integer(IK),dimension(3) :: shape !! shape of work array
@@ -54,11 +52,11 @@ subroutine test_12(error_cnt)
5452
write(error_unit,'(A)') ''
5553

5654
! populate the raw array
57-
forall (i=1_IK:imx,j=1_IK:jmx,k=1_IK:kmx) ! could use size(... , dim=...) instead of constants
55+
do concurrent (i=1_IK:imx, j=1_IK:jmx, k=1_IK:kmx) ! could use size(... , dim=...) instead of constants
5856
raw_array(i,j,k) = i + (j-1_IK)*imx + (k-1_IK)*imx*jmx
59-
end forall
57+
end do
6058

61-
call json%create_object(root,dir//file)
59+
call json%create_object(root,file)
6260
call check_errors()
6361

6462
call json%create_object(meta_array,'array data')
@@ -172,7 +170,7 @@ subroutine test_12(error_cnt)
172170
! call my_file%get(tmp_json_ptr)
173171
! call check_file_errors(associated(tmp_json_ptr,root))
174172

175-
open(file=dir//file,newunit=lun,form='formatted',action='write')
173+
open(file=file,newunit=lun,form='formatted',action='write')
176174
call my_file%print(lun)
177175
call check_file_errors()
178176
close(lun)

‎src/tests/jf_test_14.F90

+2
Original file line numberDiff line numberDiff line change
@@ -113,6 +113,8 @@ subroutine test_14(error_cnt)
113113
error_cnt = error_cnt + 1
114114
end if
115115

116+
if (allocated(new_name)) deallocate(new_name)
117+
116118
end subroutine test_14
117119

118120
subroutine rename(json,p,finished) !! change all "name" variable values to "Fred"

‎src/tests/jf_test_20.F90

+1
Original file line numberDiff line numberDiff line change
@@ -183,6 +183,7 @@ subroutine test_20(error_cnt)
183183

184184
! cleanup:
185185
call json%destroy(p)
186+
call json%destroy(root)
186187

187188
! now, just a test of the edge case:
188189
! (where p doesn't have a parent)

‎src/tests/jf_test_34.F90

+1
Original file line numberDiff line numberDiff line change
@@ -141,6 +141,7 @@ subroutine test_34(error_cnt)
141141
call json%initialize(trailing_spaces_significant=.true.)
142142
call json%create_integer(p,1_IK,CK_'a')
143143
call json%rename(p,CK_'b ')
144+
call json%destroy(p)
144145

145146
end subroutine test_34
146147

‎src/tests/jf_test_35.F90

+6-7
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ subroutine test_35(error_cnt)
2323
integer,intent(out) :: error_cnt
2424

2525
type(json_core) :: json
26-
type(json_value),pointer :: p_root,p_array
26+
type(json_value),pointer :: p_root,p_array,p_element
2727
logical(LK) :: is_valid !! True if the structure is valid.
2828
character(kind=CK,len=:),allocatable :: error_msg !! error message from `validate`
2929
integer :: i !! counter
@@ -47,12 +47,11 @@ subroutine test_35(error_cnt)
4747
call json%add(p_root,p_array)
4848
call json%add(p_root,p_array) ! this creates a malformed JSON structure
4949
elseif (i==2) then
50-
call json%create_array(p_array, '')
51-
call json%create_object(p_root, 'object')
52-
call json%add(p_root,'int',1_IK)
53-
call json%add(p_array,p_root)
54-
call json%add(p_array,p_root) ! this creates a malformed JSON structure
55-
! note: below we will destroy p_root, which is the duplicate array element
50+
call json%create_array(p_root, '')
51+
call json%create_object(p_element, 'object')
52+
call json%add(p_element,'int',1_IK)
53+
call json%add(p_root,p_element)
54+
call json%add(p_root,p_element) ! this creates a malformed JSON structure
5655
end if
5756

5857
! test initialize_json_core:

‎src/tests/jf_test_44.F90

+2
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,8 @@ subroutine test_44(error_cnt)
5252
error_cnt = error_cnt + 1
5353
end if
5454

55+
call json%destroy(p)
56+
5557
if (error_cnt==0) then
5658
write(error_unit,'(A)') 'Success!'
5759
else

‎src/tests/jf_test_47.F90

+2
Original file line numberDiff line numberDiff line change
@@ -117,6 +117,8 @@ subroutine test_47(error_cnt)
117117

118118
end if
119119

120+
call json%destroy(inp)
121+
120122
write(error_unit,'(A)') ''
121123
if (error_cnt==0) then
122124
write(error_unit,'(A)') 'Success!'

‎visual_studio/jsonfortranlib/jsonfortranlib.vfproj

+3-3
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@
2323
<Tool Name="VFPreBuildEventTool"/>
2424
<Tool Name="VFPostBuildEventTool"/></Configuration>
2525
<Configuration Name="Debug|x64" OutputDirectory="../../lib/x64" TargetName="libjsonfortrand" ConfigurationType="typeStaticLibrary">
26-
<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" Optimization="optimizeDisabled" Preprocess="preprocessYes" AdditionalIncludeDirectories="../../src" StandardWarnings="standardWarningsF08" Diagnostics="diagnosticsShowAll" WarnDeclarations="true" WarnUnusedVariables="true" WarnIgnoreLOC="true" WarnTruncateSource="true" WarnUncalled="true" WarnInterfaces="true" ModulePath="$(OutDir)\" Traceback="true" NullPointerCheck="true" BoundsCheck="true" UninitializedVariablesCheck="true" StackFrameCheck="true" RuntimeLibrary="rtMultiThreadedDebugDLL"/>
26+
<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" Optimization="optimizeDisabled" Preprocess="preprocessYes" AdditionalIncludeDirectories="../../src" StandardWarnings="standardWarningsF15" StandardWarningsAsErrors="true" Diagnostics="diagnosticsShowAll" WarnDeclarations="true" WarnUnusedVariables="true" WarnIgnoreLOC="true" WarnTruncateSource="true" WarnUncalled="true" WarnInterfaces="true" ModulePath="$(OutDir)\" Traceback="true" NullPointerCheck="true" BoundsCheck="true" UninitializedVariablesCheck="true" StackFrameCheck="true" RuntimeLibrary="rtMultiThreadedDebugDLL"/>
2727
<Tool Name="VFLibrarianTool"/>
2828
<Tool Name="VFResourceCompilerTool"/>
2929
<Tool Name="VFMidlTool" SuppressStartupBanner="true" TargetEnvironment="midlTargetAMD64"/>
@@ -42,9 +42,9 @@
4242
<Tool Name="VFPostBuildEventTool"/></Configuration></Configurations>
4343
<Files>
4444
<Filter Name="include" Filter="inc">
45-
<File RelativePath="..\..\src\json_macros.inc"/>
4645
<File RelativePath="..\..\src\json_initialize_arguments.inc"/>
47-
<File RelativePath="..\..\src\json_initialize_dummy_arguments.inc"/></Filter>
46+
<File RelativePath="..\..\src\json_initialize_dummy_arguments.inc"/>
47+
<File RelativePath="..\..\src\json_macros.inc"/></Filter>
4848
<Filter Name="src" Filter="F90;f90">
4949
<File RelativePath="..\..\src\json_file_module.F90"/>
5050
<File RelativePath="..\..\src\json_kinds.F90"/>

‎visual_studio/jsonfortrantest/jsonfortrantest.vfproj

+1-1
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@
2525
<Tool Name="VFPostBuildEventTool"/>
2626
<Tool Name="VFManifestTool" SuppressStartupBanner="true"/></Configuration>
2727
<Configuration Name="Debug|x64" OutputDirectory="../../bin" TargetName="$(ProjectName)d">
28-
<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" MultiProcessorCompilation="true" Optimization="optimizeDisabled" Preprocess="preprocessYes" AdditionalIncludeDirectories="../jsonfortranlib/x64/Debug" PreprocessorDefinitions="INTEGRATED_TESTS" WarnInterfaces="true" Traceback="true" BoundsCheck="true" StackFrameCheck="true" RuntimeLibrary="rtMultiThreadedDebugDLL"/>
28+
<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" MultiProcessorCompilation="true" Optimization="optimizeDisabled" Preprocess="preprocessYes" AdditionalIncludeDirectories="../jsonfortranlib/x64/Debug" PreprocessorDefinitions="INTEGRATED_TESTS" StandardWarnings="standardWarningsF15" StandardWarningsAsErrors="true" Diagnostics="diagnosticsShowAll" WarnInterfaces="true" Traceback="true" BoundsCheck="true" StackFrameCheck="true" RuntimeLibrary="rtMultiThreadedDebugDLL"/>
2929
<Tool Name="VFLinkerTool" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" AdditionalLibraryDirectories="../../lib/x64" GenerateDebugInformation="true" SubSystem="subSystemConsole" AdditionalDependencies="libjsonfortrand.lib"/>
3030
<Tool Name="VFResourceCompilerTool"/>
3131
<Tool Name="VFMidlTool" SuppressStartupBanner="true" TargetEnvironment="midlTargetAMD64"/>

0 commit comments

Comments
 (0)