Skip to content

Commit fa7a246

Browse files
committed
Added a rename function. Fixes #184
1 parent 6a2ec92 commit fa7a246

File tree

2 files changed

+140
-17
lines changed

2 files changed

+140
-17
lines changed

src/json_value_module.F90

Lines changed: 54 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -375,10 +375,6 @@ module json_value_module
375375
procedure :: json_value_destroy
376376
procedure :: destroy_json_core
377377

378-
!>
379-
! Remove a [[json_value]] from a linked-list structure.
380-
procedure,public :: remove => json_value_remove
381-
382378
!>
383379
! If the child variable is present, then remove it.
384380
generic,public :: remove_if_present => MAYBEWRAP(json_value_remove_if_present)
@@ -491,23 +487,17 @@ module json_value_module
491487
procedure :: json_parse_file
492488
procedure :: MAYBEWRAP(json_parse_string)
493489

494-
!>
495-
! Swap two [[json_value]] pointers in a structure
496-
! (or two different structures).
497-
generic,public :: swap => json_value_swap
498-
procedure :: json_value_swap
499-
500-
!>
501-
! Check if a [[json_value]] is a child of another.
502-
generic,public :: is_child_of => json_value_is_child_of
503-
procedure :: json_value_is_child_of
504-
505490
!>
506491
! Throw an exception.
507492
generic,public :: throw_exception => MAYBEWRAP(json_throw_exception)
508493
procedure :: MAYBEWRAP(json_throw_exception)
509494

510-
!public routines:
495+
!>
496+
! Rename a [[json_value]] variable.
497+
generic,public :: rename => MAYBEWRAP(json_value_rename)
498+
procedure :: MAYBEWRAP(json_value_rename)
499+
500+
procedure,public :: remove => json_value_remove !! Remove a [[json_value]] from a linked-list structure.
511501
procedure,public :: check_for_errors => json_check_for_errors !! check for error and get error message
512502
procedure,public :: clear_exceptions => json_clear_exceptions !! clear exceptions
513503
procedure,public :: count => json_count !! count the number of children
@@ -521,6 +511,9 @@ module json_value_module
521511
procedure,public :: initialize => json_initialize !! to initialize some parsing parameters
522512
procedure,public :: traverse => json_traverse !! to traverse all elements of a JSON structure
523513
procedure,public :: print_error_message => json_print_error_message !! simply routine to print error messages
514+
procedure,public :: swap => json_value_swap !! Swap two [[json_value]] pointers
515+
!! in a structure (or two different structures).
516+
procedure,public :: is_child_of => json_value_is_child_of !! Check if a [[json_value]] is a child of another.
524517

525518
!other private routines:
526519
procedure :: json_value_print
@@ -914,11 +907,55 @@ subroutine json_info(json,p,var_type,n_children,name)
914907

915908
if (present(var_type)) var_type = p%var_type
916909
if (present(n_children)) n_children = json%count(p)
917-
if (present(name)) name = p%name
910+
if (present(name)) then
911+
if (allocated(p%name)) then
912+
name = p%name
913+
else
914+
name = ''
915+
end if
916+
end if
918917

919918
end subroutine json_info
920919
!*****************************************************************************************
921920

921+
!*****************************************************************************************
922+
!> author: Jacob Williams
923+
! date: 4/29/2016
924+
!
925+
! Rename a [[json_value]].
926+
927+
subroutine json_value_rename(json,p,name)
928+
929+
implicit none
930+
931+
class(json_core),intent(inout) :: json
932+
type(json_value),pointer,intent(in) :: p
933+
character(kind=CK,len=*),intent(in) :: name !! new variable name
934+
935+
p%name = name
936+
937+
end subroutine json_value_rename
938+
!*****************************************************************************************
939+
940+
!*****************************************************************************************
941+
!> author: Jacob Williams
942+
! date: 4/29/2016
943+
!
944+
! Alternate version of [[json_value_rename]], where `name` is kind=CDK.
945+
946+
subroutine wrap_json_value_rename(json,p,name)
947+
948+
implicit none
949+
950+
class(json_core),intent(inout) :: json
951+
type(json_value),pointer,intent(in) :: p
952+
character(kind=CDK,len=*),intent(in) :: name !! new variable name
953+
954+
call json%rename(p,to_unicode(name))
955+
956+
end subroutine wrap_json_value_rename
957+
!*****************************************************************************************
958+
922959
!*****************************************************************************************
923960
!> author: Jacob Williams
924961
! date: 12/4/2013

src/tests/jf_test_17.f90

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
!*****************************************************************************************
2+
!> author: Jacob Williams
3+
! date: 4/29/2017
4+
!
5+
! Module for the 17th unit test.
6+
! Test the `rename` function.
7+
8+
module jf_test_17_mod
9+
10+
use json_module, CK => json_CK
11+
use, intrinsic :: iso_fortran_env , only: error_unit,output_unit
12+
13+
implicit none
14+
15+
contains
16+
17+
subroutine test_17(error_cnt)
18+
19+
!! Test the `rename` function.
20+
21+
implicit none
22+
23+
integer,intent(out) :: error_cnt !! report number of errors to caller
24+
25+
type(json_core) :: json
26+
type(json_value),pointer :: p,q
27+
28+
write(error_unit,'(A)') ''
29+
write(error_unit,'(A)') '================================='
30+
write(error_unit,'(A)') ' TEST 17'
31+
write(error_unit,'(A)') '================================='
32+
write(error_unit,'(A)') ''
33+
34+
error_cnt = 0
35+
36+
write(error_unit,'(A)') ''
37+
write(error_unit,'(A)') 'Original:'
38+
call json%parse(p, '{"city": ["New York","Los Angeles","Chicago"], '//&
39+
'"value": 1, "iflag": true, "struct":{"vec":[1,2,3]}}')
40+
if (json%failed()) then
41+
call json%print_error_message(error_unit)
42+
error_cnt = error_cnt + 1
43+
end if
44+
call json%print(p,error_unit)
45+
46+
write(error_unit,'(A)') ''
47+
write(error_unit,'(A)') 'Rename: "city" to "cities"'
48+
call json%get(p,'city',q)
49+
call json%rename(q,'cities')
50+
call json%print(p,output_unit)
51+
if (json%failed()) then
52+
call json%print_error_message(error_unit)
53+
error_cnt = error_cnt + 1
54+
end if
55+
nullify(q)
56+
!verifty that it was renamed:
57+
call json%get(p,'cities',q)
58+
if (json%failed()) then
59+
call json%print_error_message(error_unit)
60+
error_cnt = error_cnt + 1
61+
else
62+
write(error_unit,'(A)') 'Success!'
63+
end if
64+
nullify(q)
65+
66+
!cleanup:
67+
call json%destroy(p)
68+
69+
end subroutine test_17
70+
71+
end module jf_test_17_mod
72+
!*****************************************************************************************
73+
74+
!*****************************************************************************************
75+
program jf_test_17
76+
77+
!! 17th unit test.
78+
79+
use jf_test_17_mod, only: test_17
80+
implicit none
81+
integer :: n_errors
82+
call test_17(n_errors)
83+
if ( n_errors /= 0) stop 1
84+
85+
end program jf_test_17
86+
!*****************************************************************************************

0 commit comments

Comments
 (0)