@@ -218,9 +218,11 @@ module json_value_module
218
218
private
219
219
220
220
generic,public :: get_child = > json_value_get_by_index, &
221
+ json_value_get_child,&
221
222
MAYBEWRAP(json_value_get_by_name_chars)
222
223
procedure ,private :: json_value_get_by_index
223
224
procedure ,private :: MAYBEWRAP(json_value_get_by_name_chars)
225
+ procedure ,private :: json_value_get_child
224
226
225
227
! >
226
228
! Add objects to a linked list of [[json_value]]s.
@@ -1180,7 +1182,8 @@ pure function json_failed(json) result(failed)
1180
1182
implicit none
1181
1183
1182
1184
class(json_core),intent (in ) :: json
1183
- logical (LK) :: failed
1185
+ logical (LK) :: failed ! ! will be true if an exception
1186
+ ! ! has been thrown.
1184
1187
1185
1188
failed = json% exception_thrown
1186
1189
@@ -2660,15 +2663,20 @@ end subroutine json_value_add_string_vec_val_ascii
2660
2663
! Now using n_children variable.
2661
2664
! Renamed from json_value_count.
2662
2665
2663
- pure function json_count (json ,p ) result(count)
2666
+ function json_count (json ,p ) result(count)
2664
2667
2665
2668
implicit none
2666
2669
2667
- class(json_core),intent (in ) :: json
2670
+ class(json_core),intent (inout ) :: json
2668
2671
type (json_value),pointer ,intent (in ) :: p
2669
2672
integer (IK) :: count ! ! number of children
2670
2673
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
2672
2680
2673
2681
end function json_count
2674
2682
! *****************************************************************************************
@@ -2684,11 +2692,16 @@ subroutine json_get_parent(json,p,parent)
2684
2692
2685
2693
implicit none
2686
2694
2687
- class(json_core),intent (in ) :: json
2695
+ class(json_core),intent (inout ) :: json
2688
2696
type (json_value),pointer ,intent (in ) :: p ! ! JSON object
2689
2697
type (json_value),pointer ,intent (out ) :: parent ! ! pointer to parent
2690
2698
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
2692
2705
2693
2706
end subroutine json_get_parent
2694
2707
! *****************************************************************************************
@@ -2704,11 +2717,16 @@ subroutine json_get_next(json,p,next)
2704
2717
2705
2718
implicit none
2706
2719
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
2709
2722
type (json_value),pointer ,intent (out ) :: next ! ! pointer to next
2710
2723
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
2712
2730
2713
2731
end subroutine json_get_next
2714
2732
! *****************************************************************************************
@@ -2724,11 +2742,16 @@ subroutine json_get_previous(json,p,previous)
2724
2742
2725
2743
implicit none
2726
2744
2727
- class(json_core),intent (in ) :: json
2745
+ class(json_core),intent (inout ) :: json
2728
2746
type (json_value),pointer ,intent (in ) :: p ! ! JSON object
2729
2747
type (json_value),pointer ,intent (out ) :: previous ! ! pointer to previous
2730
2748
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
2732
2755
2733
2756
end subroutine json_get_previous
2734
2757
! *****************************************************************************************
@@ -2745,11 +2768,16 @@ subroutine json_get_tail(json,p,tail)
2745
2768
2746
2769
implicit none
2747
2770
2748
- class(json_core),intent (in ) :: json
2771
+ class(json_core),intent (inout ) :: json
2749
2772
type (json_value),pointer ,intent (in ) :: p ! ! JSON object
2750
2773
type (json_value),pointer ,intent (out ) :: tail ! ! pointer to tail
2751
2774
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
2753
2781
2754
2782
end subroutine json_get_tail
2755
2783
! *****************************************************************************************
@@ -2802,6 +2830,29 @@ subroutine json_value_get_by_index(json, p, idx, child)
2802
2830
end subroutine json_value_get_by_index
2803
2831
! *****************************************************************************************
2804
2832
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
+
2805
2856
! *****************************************************************************************
2806
2857
! >
2807
2858
! Returns a child in the object or array given the name string.
0 commit comments