@@ -181,12 +181,16 @@ module json_module
181
181
182
182
! the data for this variable:
183
183
type (json_data_non_polymorphic) :: data
184
+
185
+ ! number of children:
186
+ integer ,private :: n_children = 0
184
187
185
188
! for the linked list:
186
189
type (json_value), pointer :: previous = > null ()
187
- type (json_value), pointer :: next = > null ()
188
- type (json_value), pointer :: parent = > null ()
190
+ type (json_value), pointer :: next = > null ()
191
+ type (json_value), pointer :: parent = > null ()
189
192
type (json_value), pointer :: children = > null ()
193
+ type (json_value), pointer :: tail = > null ()
190
194
191
195
end type json_value
192
196
! *********************************************************
@@ -1270,9 +1274,14 @@ recursive subroutine json_value_destroy(this)
1270
1274
call this% data % destroy()
1271
1275
1272
1276
if (associated (this% children)) call json_value_destroy(this% children)
1277
+ this% n_children = 0
1278
+
1279
+ if (associated (this% next)) call json_value_destroy(this% next)
1273
1280
1274
- if (associated (this% next)) call json_value_destroy(this% next)
1275
-
1281
+ if (associated (this% previous)) nullify(this% previous)
1282
+ if (associated (this% parent)) nullify(this% parent)
1283
+ if (associated (this% tail)) nullify(this% tail)
1284
+
1276
1285
deallocate (this)
1277
1286
1278
1287
nullify(this)
@@ -1329,50 +1338,54 @@ subroutine json_value_remove(me,destroy)
1329
1338
1330
1339
type (json_value),pointer :: parent,previous,next
1331
1340
logical :: destroy_it
1332
-
1341
+
1333
1342
if (associated (me)) then
1343
+
1344
+ ! optional input argument:
1345
+ if (present (destroy)) then
1346
+ destroy_it = destroy
1347
+ else
1348
+ destroy_it = .true.
1349
+ end if
1334
1350
1335
1351
if (associated (me% parent)) then
1336
1352
1337
- ! optional input argument:
1338
- if (present (destroy)) then
1339
- destroy_it = destroy
1340
- else
1341
- destroy_it = .true.
1342
- end if
1343
-
1353
+ parent = > me% parent
1354
+
1344
1355
if (associated (me% next)) then
1345
1356
1346
1357
! there are later items in the list:
1347
1358
1348
1359
next = > me% next
1349
1360
nullify(me% next)
1350
1361
1351
- if (associated (me% previous)) then
1362
+ if (associated (me% previous)) then
1352
1363
! there are earlier items in the list
1353
1364
previous = > me% previous
1354
1365
previous% next = > next
1355
1366
next% previous = > previous
1356
1367
else
1357
1368
! this is the first item in the list
1358
- parent = > me% parent
1359
1369
parent% children = > next
1360
- next% previous = > null ( )
1370
+ nullify( next% previous)
1361
1371
end if
1362
1372
1363
1373
else
1364
1374
1365
1375
if (associated (me% previous)) then
1366
1376
! there are earlier items in the list:
1367
1377
previous = > me% previous
1368
- previous% next = > null ()
1378
+ nullify(previous% next)
1379
+ parent% tail = > previous
1369
1380
else
1370
1381
! this is the only item in the list:
1371
- parent = > me % parent
1372
- parent% children = > null ()
1382
+ nullify( parent% children)
1383
+ nullify( parent% tail)
1373
1384
end if
1374
1385
1375
- end if
1386
+ end if
1387
+
1388
+ parent% n_children = parent% n_children - 1
1376
1389
1377
1390
end if
1378
1391
@@ -1618,35 +1631,29 @@ subroutine json_value_add_member(this, member)
1618
1631
1619
1632
type (json_value), pointer :: this, member
1620
1633
1621
- type (json_value), pointer :: p
1634
+ ! type(json_value), pointer :: p
1622
1635
1623
1636
if (.not. exception_thrown) then
1624
1637
1625
- nullify(p)
1626
-
1627
1638
! associate the parent
1628
1639
member % parent = > this
1629
1640
1630
1641
! add to linked list
1631
- if (associated (this % children)) then
1632
-
1633
- ! get to the tail of the linked list
1634
- p = > this % children
1635
- do while (associated (p % next))
1636
- p = > p % next
1637
- end do
1638
-
1639
- p% next = > member
1640
- member% previous = > p
1642
+ if (associated (this% children)) then
1641
1643
1642
- nullify(p) ! cleanup
1644
+ this% tail% next = > member
1645
+ member% previous = > this% tail
1643
1646
1644
1647
else
1645
1648
1646
1649
this% children = > member
1647
- member% previous = > null ()
1650
+ member% previous = > null () ! first in the list
1648
1651
1649
1652
end if
1653
+
1654
+ ! new member is now the last one in the list
1655
+ this% tail = > member
1656
+ this% n_children = this% n_children + 1
1650
1657
1651
1658
end if
1652
1659
@@ -2090,39 +2097,20 @@ end subroutine json_value_add_string_vec
2090
2097
! DESCRIPTION
2091
2098
! Count the number of children.
2092
2099
!
2100
+ ! HISTORY
2101
+ ! JW : 1/4/2014 : Original routine removed.
2102
+ ! Now using n_children variable.
2103
+ !
2093
2104
! SOURCE
2094
2105
2095
- function json_value_count (this ) result(count)
2106
+ function json_value_count (me ) result(count)
2096
2107
2097
2108
implicit none
2098
2109
2099
2110
integer :: count
2100
- type (json_value),pointer ,intent (in ) :: this
2101
-
2102
- type (json_value), pointer :: p
2103
-
2104
- if (.not. exception_thrown) then
2105
-
2106
- count = 0
2107
-
2108
- if (associated (this)) then
2109
-
2110
- if (associated (this% children)) then
2111
-
2112
- p = > this% children
2113
-
2114
- do while (associated (p))
2115
- count = count + 1
2116
- p = > p% next
2117
- end do
2118
-
2119
- nullify(p)
2120
-
2121
- end if
2122
-
2123
- end if
2124
-
2125
- end if
2111
+ type (json_value),pointer ,intent (in ) :: me
2112
+
2113
+ count = me% n_children
2126
2114
2127
2115
end function json_value_count
2128
2116
! *****************************************************************************************
@@ -3534,9 +3522,10 @@ subroutine json_get_array(this, path, array_callback, found)
3534
3522
select case (p% data % var_type)
3535
3523
case (json_array)
3536
3524
count = json_value_count(p)
3537
- do i = 1 , count
3538
- call json_value_get(p, i, element)
3525
+ element = > p % children
3526
+ do i = 1 , count ! callback for each child
3539
3527
call array_callback(element, i, count)
3528
+ element = > element% next
3540
3529
end do
3541
3530
case default
3542
3531
call throw_exception(' Error in json_get_array:' // &
0 commit comments