Skip to content

Commit 9d4f736

Browse files
committed
added a new get_child method to get the first child.
added some additional error checks for unassociated pointers.
1 parent 8b5ba08 commit 9d4f736

File tree

1 file changed

+64
-13
lines changed

1 file changed

+64
-13
lines changed

src/json_value_module.F90

+64-13
Original file line numberDiff line numberDiff line change
@@ -218,9 +218,11 @@ module json_value_module
218218
private
219219

220220
generic,public :: get_child => json_value_get_by_index, &
221+
json_value_get_child,&
221222
MAYBEWRAP(json_value_get_by_name_chars)
222223
procedure,private :: json_value_get_by_index
223224
procedure,private :: MAYBEWRAP(json_value_get_by_name_chars)
225+
procedure,private :: json_value_get_child
224226

225227
!>
226228
! Add objects to a linked list of [[json_value]]s.
@@ -1180,7 +1182,8 @@ pure function json_failed(json) result(failed)
11801182
implicit none
11811183

11821184
class(json_core),intent(in) :: json
1183-
logical(LK) :: failed
1185+
logical(LK) :: failed !! will be true if an exception
1186+
!! has been thrown.
11841187

11851188
failed = json%exception_thrown
11861189

@@ -2660,15 +2663,20 @@ end subroutine json_value_add_string_vec_val_ascii
26602663
! Now using n_children variable.
26612664
! Renamed from json_value_count.
26622665

2663-
pure function json_count(json,p) result(count)
2666+
function json_count(json,p) result(count)
26642667

26652668
implicit none
26662669

2667-
class(json_core),intent(in) :: json
2670+
class(json_core),intent(inout) :: json
26682671
type(json_value),pointer,intent(in) :: p
26692672
integer(IK) :: count !! number of children
26702673

2671-
count = p%n_children
2674+
if (associated(p)) then
2675+
count = p%n_children
2676+
else
2677+
call json%throw_exception('Error in json_count: '//&
2678+
'pointer is not associated.')
2679+
end if
26722680

26732681
end function json_count
26742682
!*****************************************************************************************
@@ -2684,11 +2692,16 @@ subroutine json_get_parent(json,p,parent)
26842692

26852693
implicit none
26862694

2687-
class(json_core),intent(in) :: json
2695+
class(json_core),intent(inout) :: json
26882696
type(json_value),pointer,intent(in) :: p !! JSON object
26892697
type(json_value),pointer,intent(out) :: parent !! pointer to parent
26902698

2691-
parent => p%parent
2699+
if (associated(p)) then
2700+
parent => p%parent
2701+
else
2702+
call json%throw_exception('Error in json_get_parent: '//&
2703+
'pointer is not associated.')
2704+
end if
26922705

26932706
end subroutine json_get_parent
26942707
!*****************************************************************************************
@@ -2704,11 +2717,16 @@ subroutine json_get_next(json,p,next)
27042717

27052718
implicit none
27062719

2707-
class(json_core),intent(in) :: json
2708-
type(json_value),pointer,intent(in) :: p !! JSON object
2720+
class(json_core),intent(inout) :: json
2721+
type(json_value),pointer,intent(in) :: p !! JSON object
27092722
type(json_value),pointer,intent(out) :: next !! pointer to next
27102723

2711-
next => p%next
2724+
if (associated(p)) then
2725+
next => p%next
2726+
else
2727+
call json%throw_exception('Error in json_get_next: '//&
2728+
'pointer is not associated.')
2729+
end if
27122730

27132731
end subroutine json_get_next
27142732
!*****************************************************************************************
@@ -2724,11 +2742,16 @@ subroutine json_get_previous(json,p,previous)
27242742

27252743
implicit none
27262744

2727-
class(json_core),intent(in) :: json
2745+
class(json_core),intent(inout) :: json
27282746
type(json_value),pointer,intent(in) :: p !! JSON object
27292747
type(json_value),pointer,intent(out) :: previous !! pointer to previous
27302748

2731-
previous => p%previous
2749+
if (associated(p)) then
2750+
previous => p%previous
2751+
else
2752+
call json%throw_exception('Error in json_get_previous: '//&
2753+
'pointer is not associated.')
2754+
end if
27322755

27332756
end subroutine json_get_previous
27342757
!*****************************************************************************************
@@ -2745,11 +2768,16 @@ subroutine json_get_tail(json,p,tail)
27452768

27462769
implicit none
27472770

2748-
class(json_core),intent(in) :: json
2771+
class(json_core),intent(inout) :: json
27492772
type(json_value),pointer,intent(in) :: p !! JSON object
27502773
type(json_value),pointer,intent(out) :: tail !! pointer to tail
27512774

2752-
tail => p%tail
2775+
if (associated(p)) then
2776+
tail => p%tail
2777+
else
2778+
call json%throw_exception('Error in json_get_tail: '//&
2779+
'pointer is not associated.')
2780+
end if
27532781

27542782
end subroutine json_get_tail
27552783
!*****************************************************************************************
@@ -2802,6 +2830,29 @@ subroutine json_value_get_by_index(json, p, idx, child)
28022830
end subroutine json_value_get_by_index
28032831
!*****************************************************************************************
28042832

2833+
!*****************************************************************************************
2834+
!>
2835+
! Returns pointer to the first child of the object
2836+
! (or null() if it is not associated).
2837+
2838+
subroutine json_value_get_child(json, p, child)
2839+
2840+
implicit none
2841+
2842+
class(json_core),intent(inout) :: json
2843+
type(json_value),pointer,intent(in) :: p !! object or array JSON data
2844+
type(json_value),pointer :: child !! pointer to the child
2845+
2846+
if (associated(p)) then
2847+
child => p%children
2848+
else
2849+
call json%throw_exception('Error in json_value_get_child: '//&
2850+
'pointer is not associated.')
2851+
end if
2852+
2853+
end subroutine json_value_get_child
2854+
!*****************************************************************************************
2855+
28052856
!*****************************************************************************************
28062857
!>
28072858
! Returns a child in the object or array given the name string.

0 commit comments

Comments
 (0)