Skip to content

Commit f84e9fe

Browse files
committed
added a new routine to remove an item from a json structure.
added a test case for it.
1 parent c12d324 commit f84e9fe

File tree

2 files changed

+96
-4
lines changed

2 files changed

+96
-4
lines changed

src/json_example.f90

Lines changed: 19 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ program json_test
1010
! Unit tests for the json_module.
1111
!
1212
! USES
13-
! json_module
13+
! json_module
1414
!
1515
! HISTORY
1616
! Jacob Williams : 2/8/2014 : Created
@@ -472,6 +472,7 @@ subroutine test_1()
472472
character(len=:),allocatable :: cval
473473
real(wp) :: rval
474474
logical :: found
475+
type(json_value),pointer :: p
475476

476477
write(*,'(A)') ''
477478
write(*,'(A)') '================================='
@@ -584,7 +585,23 @@ subroutine test_1()
584585
else
585586
write(*,'(A)') 'version.blah = ',ival
586587
end if
587-
588+
589+
write(*,'(A)') ''
590+
write(*,'(A)') ' Test removing data from the json structure:'
591+
592+
call json%get('files', p) !in the middle of a list
593+
call json_remove(p)
594+
595+
call json%get('data(1).array', p) !at the end of a list
596+
call json_remove(p)
597+
598+
call json%get('data(2).number', p) !at the beginning of a list
599+
call json_remove(p)
600+
601+
write(*,'(A)') ''
602+
write(*,'(A)') 'printing the modified structure...'
603+
call json%print_file()
604+
588605
end if
589606

590607
! clean up

src/json_module.f90

Lines changed: 77 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -171,6 +171,7 @@ module json_module
171171
type(json_data_non_polymorphic) :: data
172172

173173
!for the linked list:
174+
type(json_value), pointer :: previous => null()
174175
type(json_value), pointer :: next => null()
175176
type(json_value), pointer :: parent => null()
176177
type(json_value), pointer :: children => null()
@@ -283,10 +284,15 @@ end subroutine array_callback_func
283284
interface json_destroy
284285
module procedure :: json_value_destroy
285286
end interface
287+
288+
interface json_remove
289+
module procedure :: json_value_remove
290+
end interface
286291

287292
!public routines:
288293
public :: json_initialize !to initialize the module
289294
public :: json_destroy !clear a JSON structure (destructor)
295+
public :: json_remove !remove from a JSON structure
290296
public :: json_parse !read a JSON file and populate the structure
291297
public :: json_clear_exceptions !clear exceptions
292298
public :: json_check_for_errors !check for error and get error message
@@ -1055,6 +1061,73 @@ recursive subroutine json_value_destroy(this)
10551061
end subroutine json_value_destroy
10561062
!*****************************************************************************************
10571063

1064+
!*****************************************************************************************
1065+
!****f* json_module/json_value_remove
1066+
!
1067+
! NAME
1068+
! json_value_destroy
1069+
!
1070+
! DESCRIPTION
1071+
! Remove and destroy a json_value (and all its children)
1072+
! from a linked-list structure.
1073+
!
1074+
! AUTHOR
1075+
! Jacob Williams : 9/9/2014
1076+
!
1077+
! SOURCE
1078+
1079+
subroutine json_value_remove(me)
1080+
1081+
implicit none
1082+
1083+
type(json_value),pointer :: me
1084+
1085+
type(json_value),pointer :: parent,previous,next
1086+
1087+
if (associated(me)) then
1088+
if (associated(me%parent)) then
1089+
if (associated(me%next)) then
1090+
1091+
!there are later items in the list:
1092+
1093+
next => me%next
1094+
nullify(me%next)
1095+
1096+
if (associated(me%previous)) then
1097+
!there are earlier items in the list
1098+
previous => me%previous
1099+
previous%next => next
1100+
next%previous => previous
1101+
else
1102+
!this is the first item in the list
1103+
parent => me%parent
1104+
parent%children => next
1105+
next%previous => null()
1106+
end if
1107+
1108+
else
1109+
1110+
if (associated(me%previous)) then
1111+
!there are earlier items in the list:
1112+
previous => me%previous
1113+
previous%next => null()
1114+
else
1115+
!this is the only item in the list:
1116+
parent => me%parent
1117+
parent%children => null()
1118+
end if
1119+
1120+
end if
1121+
1122+
end if
1123+
1124+
call json_value_destroy(me)
1125+
1126+
end if
1127+
1128+
end subroutine json_value_remove
1129+
!*****************************************************************************************
1130+
10581131
!*****************************************************************************************
10591132
!****f* json_module/json_value_add_member
10601133
!
@@ -1090,13 +1163,15 @@ subroutine json_value_add_member(this, member)
10901163
p => p % next
10911164
end do
10921165

1093-
p % next => member
1166+
p%next => member
1167+
member%previous => p
10941168

10951169
nullify(p) !cleanup
10961170

10971171
else
10981172

1099-
this % children => member
1173+
this%children => member
1174+
member%previous => null()
11001175

11011176
end if
11021177

0 commit comments

Comments
 (0)