Skip to content

Commit 1ba58a8

Browse files
jacobwilliamsjacobwilliams
committed
cleanup in swap routine.
1 parent 9ec4ad9 commit 1ba58a8

File tree

1 file changed

+20
-54
lines changed

1 file changed

+20
-54
lines changed

‎src/json_value_module.F90

Lines changed: 20 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -1305,6 +1305,12 @@ end subroutine json_value_remove
13051305
! Only the simple cases where p1/p2 or p2/p1 are parent/child
13061306
! are currently checked.
13071307
!
1308+
!@warning There are also other situations where using this routine would
1309+
! produce a malformed JSON structure, such as swapping an array
1310+
! with one of its children. This is not checked for.
1311+
!
1312+
!@note If `p1` and `p2` have a common parent, it is always safe to swap them.
1313+
!
13081314
!@warning This is a work-in-progress and has not yet been fully validated.
13091315

13101316
subroutine json_value_swap(json,p1,p2)
@@ -1315,10 +1321,8 @@ subroutine json_value_swap(json,p1,p2)
13151321
type(json_value),pointer :: p1
13161322
type(json_value),pointer :: p2
13171323

1318-
logical :: same_parent,first_last
1319-
type(json_value),pointer :: p1_par_first,p1_par_last,p2_par_first,p2_par_last
1324+
logical :: same_parent,first_last,adjacent
13201325
type(json_value),pointer :: a,b
1321-
logical :: adjacent
13221326

13231327
if (json%exception_thrown) return
13241328

@@ -1331,7 +1335,6 @@ subroutine json_value_swap(json,p1,p2)
13311335

13321336
!TODO Need to check *all* the `children` pointers, so make sure
13331337
! cases like p1%child%...%child => p2 don't occur...
1334-
! .... or is that case OK? ....
13351338
if (associated(p1%parent,p2) .or. associated(p2%parent,p1)) then
13361339
call json%throw_exception('Error in json_value_swap: '//&
13371340
'cannot swap a parent/child pair')
@@ -1341,6 +1344,7 @@ subroutine json_value_swap(json,p1,p2)
13411344
associated(p2%parent) .and. &
13421345
associated(p1%parent,p2%parent) )
13431346
if (same_parent) then
1347+
!if p1,p2 are the first,last or last,first children of a common parent
13441348
first_last = (associated(p1%parent%children,p1) .and. &
13451349
associated(p2%parent%tail,p2)) .or. &
13461350
(associated(p1%parent%tail,p1) .and. &
@@ -1356,67 +1360,29 @@ subroutine json_value_swap(json,p1,p2)
13561360
!this is all we have to do for the parent in this case:
13571361
call swap_pointers(p1%parent%children,p2%parent%tail)
13581362

1359-
elseif (same_parent .and. .not. first_last) then
1363+
else if (same_parent .and. .not. first_last) then
13601364

13611365
if (associated(p1%parent%children,p1)) then
1362-
! if p1 is the first child of its parent:
1363-
p1%parent%children => p2
1364-
elseif (associated(p1%parent%children,p2)) then
1365-
! if p2 is the first child of its parent:
1366-
p1%parent%children => p1
1366+
p1%parent%children => p2 ! p1 is the first child of the parent
1367+
else if (associated(p1%parent%children,p2)) then
1368+
p1%parent%children => p1 ! p2 is the first child of the parent
13671369
end if
13681370
if (associated(p1%parent%tail,p1)) then
1369-
! if p1 is the last child of its parent:
1370-
p1%parent%tail => p2
1371-
elseif (associated(p1%parent%tail,p2)) then
1372-
p1%parent%tail => p1
1371+
p1%parent%tail => p2 ! p1 is the last child of the parent
1372+
else if (associated(p1%parent%tail,p2)) then
1373+
p1%parent%tail => p1 ! p2 is the last child of the parent
13731374
end if
13741375

13751376
else ! general case: different parents
13761377

1377-
!... see if we can clean this up ...
1378-
1379-
p1_par_first => null()
1380-
p1_par_last => null()
1381-
p2_par_first => null()
1382-
p2_par_last => null()
1383-
if (associated(p1%parent)) then
1384-
if (associated(p1%parent%children,p1)) then
1385-
! if p1 is the first child of its parent:
1386-
p1_par_first => p2
1387-
else
1388-
p1_par_first => p1%parent%children !no change
1389-
end if
1390-
if (associated(p1%parent%tail,p1)) then
1391-
! if p1 is the last child of its parent:
1392-
p1_par_last => p2
1393-
else
1394-
p1_par_last => p1%parent%tail ! no change
1395-
end if
1396-
end if
1397-
if (associated(p2%parent)) then
1398-
if (associated(p2%parent%children,p2)) then
1399-
! if p2 is the first child of its parent:
1400-
p2_par_first => p1
1401-
else
1402-
p2_par_first => p2%parent%children !no change
1403-
end if
1404-
if (associated(p2%parent%tail,p2)) then
1405-
! if p2 is the last child of its parent:
1406-
p2_par_last => p1
1407-
else
1408-
p2_par_last => p2%parent%tail !no change
1409-
end if
1410-
end if
14111378
if (associated(p1%parent)) then
1412-
p1%parent%children => p1_par_first
1413-
p1%parent%tail => p1_par_last
1379+
if (associated(p1%parent%children,p1)) p1%parent%children => p2
1380+
if (associated(p1%parent%tail,p1)) p1%parent%tail => p2
14141381
end if
14151382
if (associated(p2%parent)) then
1416-
p2%parent%children => p2_par_first
1417-
p2%parent%tail => p2_par_last
1383+
if (associated(p2%parent%children,p2)) p2%parent%children => p1
1384+
if (associated(p2%parent%tail,p2)) p2%parent%tail => p1
14181385
end if
1419-
14201386
call swap_pointers(p1%parent, p2%parent)
14211387

14221388
end if
@@ -5743,7 +5709,7 @@ recursive function pop_char(json, unit, str, eof, skip_ws) result(popped)
57435709
eof = .true.
57445710
exit
57455711

5746-
elseif (IS_IOSTAT_EOR(ios) .or. c==newline) then !end of record
5712+
else if (IS_IOSTAT_EOR(ios) .or. c==newline) then !end of record
57475713

57485714
json%char_count = 0
57495715
json%line_count = json%line_count + 1

0 commit comments

Comments
 (0)