Skip to content

Commit 1b8fb18

Browse files
jacobwilliamsjacobwilliams
authored
Merge pull request #350 from jacobwilliams/307-nag-fix
Dangling pointer issue
2 parents 5fabf52 + 77ff643 commit 1b8fb18

File tree

4 files changed

+62
-46
lines changed

4 files changed

+62
-46
lines changed

‎src/json_parameters.F90

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -45,8 +45,10 @@ module json_parameters
4545
character(kind=CK,len=*),parameter :: end_array = CK_']' !! end of a JSON array
4646
character(kind=CK,len=*),parameter :: delimiter = CK_',' !! delimiter for JSON
4747
character(kind=CK,len=*),parameter :: colon_char = CK_':' !! colon character for JSON
48-
character(kind=CK,len=*),parameter :: start_array_alt = CK_'(' !! alternate start of JSON array for [[json_get_by_path_default]]
49-
character(kind=CK,len=*),parameter :: end_array_alt = CK_')' !! alternate end of JSON array for [[json_get_by_path_default]]
48+
character(kind=CK,len=*),parameter :: start_array_alt = CK_'(' !! alternate start of JSON array for
49+
!! [[json_get_by_path_default]]
50+
character(kind=CK,len=*),parameter :: end_array_alt = CK_')' !! alternate end of JSON array for
51+
!! [[json_get_by_path_default]]
5052
character(kind=CK,len=*),parameter :: root = CK_'$' !! root for [[json_get_by_path_default]]
5153
character(kind=CK,len=*),parameter :: this = CK_'@' !! 'this' for [[json_get_by_path_default]]
5254
character(kind=CK,len=*),parameter :: dot = CK_'.' !! path separator for [[json_get_by_path_default]]

‎src/json_value_module.F90

Lines changed: 47 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -721,30 +721,31 @@ module json_value_module
721721
!! children for duplicate keys
722722

723723
!other private routines:
724-
procedure :: name_equal
725-
procedure :: name_strings_equal
726-
procedure :: json_value_print
727-
procedure :: string_to_int
728-
procedure :: string_to_dble
729-
procedure :: parse_value
730-
procedure :: parse_number
731-
procedure :: parse_string
732-
procedure :: parse_for_chars
733-
procedure :: parse_object
734-
procedure :: parse_array
735-
procedure :: annotate_invalid_json
736-
procedure :: pop_char
737-
procedure :: push_char
738-
procedure :: get_current_line_from_file_stream
739-
procedure :: get_current_line_from_file_sequential
740-
procedure :: convert
741-
procedure :: to_string
742-
procedure :: to_logical
743-
procedure :: to_integer
744-
procedure :: to_double
745-
procedure :: to_null
746-
procedure :: to_object
747-
procedure :: to_array
724+
procedure :: name_equal
725+
procedure :: name_strings_equal
726+
procedure :: json_value_print
727+
procedure :: string_to_int
728+
procedure :: string_to_dble
729+
procedure :: parse_value
730+
procedure :: parse_number
731+
procedure :: parse_string
732+
procedure :: parse_for_chars
733+
procedure :: parse_object
734+
procedure :: parse_array
735+
procedure :: annotate_invalid_json
736+
procedure :: pop_char
737+
procedure :: push_char
738+
procedure :: get_current_line_from_file_stream
739+
procedure,nopass :: get_current_line_from_file_sequential
740+
procedure :: convert
741+
procedure :: to_string
742+
procedure :: to_logical
743+
procedure :: to_integer
744+
procedure :: to_double
745+
procedure :: to_null
746+
procedure :: to_object
747+
procedure :: to_array
748+
procedure,nopass :: json_value_clone_func
748749

749750
end type json_core
750751
!*********************************************************
@@ -1143,8 +1144,7 @@ subroutine json_clone(json,from,to)
11431144
!! (it must not already be associated)
11441145

11451146
!call the main function:
1146-
! [note: this is not part of json_core class]
1147-
call json_value_clone_func(from,to)
1147+
call json%json_value_clone_func(from,to)
11481148

11491149
end subroutine json_clone
11501150
!*****************************************************************************************
@@ -2052,9 +2052,10 @@ recursive subroutine json_value_destroy(json,p,destroy_next)
20522052
logical(LK),intent(in),optional :: destroy_next !! if true, then `p%next`
20532053
!! is also destroyed (default is true)
20542054

2055-
logical(LK) :: des_next !! local copy of `destroy_next` optional argument
2056-
type(json_value), pointer :: child !! for getting child elements
2057-
logical :: circular !! to check to malformed linked lists
2055+
logical(LK) :: des_next !! local copy of `destroy_next`
2056+
!! optional argument
2057+
type(json_value),pointer :: child !! for getting child elements
2058+
logical :: circular !! to check to malformed linked lists
20582059

20592060
if (associated(p)) then
20602061

@@ -2097,9 +2098,9 @@ recursive subroutine json_value_destroy(json,p,destroy_next)
20972098

20982099
if (associated(p%next) .and. des_next) call json%destroy(p%next)
20992100

2100-
if (associated(p%previous)) nullify(p%previous)
2101-
if (associated(p%parent)) nullify(p%parent)
2102-
if (associated(p%tail)) nullify(p%tail)
2101+
nullify(p%previous)
2102+
nullify(p%parent)
2103+
nullify(p%tail)
21032104

21042105
if (associated(p)) deallocate(p)
21052106
nullify(p)
@@ -2154,8 +2155,10 @@ subroutine json_value_remove(json,p,destroy)
21542155
!! * If `destroy` is present and true, it is destroyed.
21552156
!! * If `destroy` is present and false, it is not destroyed.
21562157

2157-
type(json_value),pointer :: parent,previous,next
2158-
logical(LK) :: destroy_it
2158+
type(json_value),pointer :: parent !! pointer to parent
2159+
type(json_value),pointer :: previous !! pointer to previous
2160+
type(json_value),pointer :: next !! pointer to next
2161+
logical(LK) :: destroy_it !! if `p` should be destroyed
21592162

21602163
if (associated(p)) then
21612164

@@ -2324,11 +2327,16 @@ subroutine json_value_swap(json,p1,p2)
23242327
implicit none
23252328

23262329
class(json_core),intent(inout) :: json
2327-
type(json_value),pointer :: p1
2328-
type(json_value),pointer :: p2
2330+
type(json_value),pointer :: p1 !! swap with `p2`
2331+
type(json_value),pointer :: p2 !! swap with `p1`
23292332

2330-
logical :: same_parent,first_last,adjacent
2331-
type(json_value),pointer :: a,b
2333+
logical :: same_parent !! if `p1` and `p2` have the same parent
2334+
logical :: first_last !! if `p1` and `p2` are the first,last or
2335+
!! last,first children of a common parent
2336+
logical :: adjacent !! if `p1` and `p2` are adjacent
2337+
!! elements in an array
2338+
type(json_value),pointer :: a !! temporary variable
2339+
type(json_value),pointer :: b !! temporary variable
23322340

23332341
if (json%exception_thrown) return
23342342

@@ -2349,8 +2357,6 @@ subroutine json_value_swap(json,p1,p2)
23492357
associated(p2%parent) .and. &
23502358
associated(p1%parent,p2%parent) )
23512359
if (same_parent) then
2352-
!if p1,p2 are the first,last or last,first
2353-
!children of a common parent
23542360
first_last = (associated(p1%parent%children,p1) .and. &
23552361
associated(p2%parent%tail,p2)) .or. &
23562362
(associated(p1%parent%tail,p1) .and. &
@@ -8931,11 +8937,10 @@ end subroutine annotate_invalid_json
89318937
! The file is assumed to be opened.
89328938
! This is the SEQUENTIAL version (see also [[get_current_line_from_file_stream]]).
89338939

8934-
subroutine get_current_line_from_file_sequential(json,iunit,line)
8940+
subroutine get_current_line_from_file_sequential(iunit,line)
89358941

89368942
implicit none
89378943

8938-
class(json_core),intent(inout) :: json
89398944
integer(IK),intent(in) :: iunit !! file unit number
89408945
character(kind=CK,len=:),allocatable,intent(out) :: line !! current line
89418946

‎visual_studio/jsonfortrantest/jsonfortrantest.f90

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,8 @@
22
!>
33
! Entry point for the unified unit test application.
44
!
5-
! Runs through all the tests in the `tests` folder
6-
! Returns 1 if there are any errors.
5+
! Runs all the tests in the `tests` folder
6+
! Returns `1` if there are any errors.
77

88
program jsonfortrantest
99

@@ -39,6 +39,9 @@ program jsonfortrantest
3939
use jf_test_30_mod , only: test_30
4040
use jf_test_31_mod , only: test_31
4141
use jf_test_32_mod , only: test_32
42+
use jf_test_33_mod , only: test_33
43+
use jf_test_34_mod , only: test_34
44+
use jf_test_35_mod , only: test_35
4245

4346
implicit none
4447

@@ -78,6 +81,9 @@ program jsonfortrantest
7881
call test_30(n_errors); if (n_errors /= 0) stop 1
7982
call test_31(n_errors); if (n_errors /= 0) stop 1
8083
call test_32(n_errors); if (n_errors /= 0) stop 1
84+
call test_33(n_errors); if (n_errors /= 0) stop 1
85+
call test_34(n_errors); if (n_errors /= 0) stop 1
86+
call test_35(n_errors); if (n_errors /= 0) stop 1
8187

8288
end program jsonfortrantest
8389
!*****************************************************************************************

‎visual_studio/jsonfortrantest/jsonfortrantest.vfproj

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -78,5 +78,8 @@
7878
<File RelativePath="..\..\src\tests\jf_test_30.F90"/>
7979
<File RelativePath="..\..\src\tests\jf_test_31.F90"/>
8080
<File RelativePath="..\..\src\tests\jf_test_32.F90"/>
81+
<File RelativePath="..\..\src\tests\jf_test_33.F90"/>
82+
<File RelativePath="..\..\src\tests\jf_test_34.F90"/>
83+
<File RelativePath="..\..\src\tests\jf_test_35.F90"/>
8184
<File RelativePath=".\jsonfortrantest.f90"/></Filter></Files>
8285
<Globals/></VisualStudioProject>

0 commit comments

Comments
 (0)