Merge pull request #425 from jacobwilliams/424-json-info

json_info will now check for exceptions and raise one if the pointer …

Author: jacobwilliams

src/json_value_module.F90

@@ -1408,14 +1408,28 @@ subroutine json_info(json,p,var_type,n_children,name)
     integer(IK),intent(out),optional :: n_children !! number of children
     character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name
 
-    if (present(var_type))    var_type   = p%var_type
-    if (present(n_children))  n_children = json%count(p)
-    if (present(name)) then
-        if (allocated(p%name)) then
-            name = p%name
-        else
-            name = CK_''
+    if (.not. json%exception_thrown .and. associated(p)) then
+
+        if (present(var_type))    var_type   = p%var_type
+        if (present(n_children))  n_children = json%count(p)
+        if (present(name)) then
+            if (allocated(p%name)) then
+                name = p%name
+            else
+                name = CK_''
+            end if
         end if
+
+    else ! error
+
+        if (.not. json%exception_thrown) then
+            call json%throw_exception('Error in json_info: '//&
+                                      'pointer is not associated.' )
+        end if
+        if (present(var_type))   var_type   = json_unknown
+        if (present(n_children)) n_children = 0
+        if (present(name))       name       = CK_''
+
     end if
 
     end subroutine json_info

src/tests/jf_test_15.F90

@@ -26,7 +26,7 @@ subroutine test_15(error_cnt)
     integer,intent(out) :: error_cnt !! report number of errors to caller
 
     type(json_core) :: json
-    type(json_value),pointer :: p,p2
+    type(json_value),pointer :: p,p2,p3
     type(json_file) :: file1, file2
     logical(LK) :: found,status_ok
     integer(IK) :: var_type,i,n_children
@@ -36,6 +36,7 @@ subroutine test_15(error_cnt)
     integer(IK),dimension(:),allocatable :: ivec
     real(wp),dimension(:),allocatable    :: rvec
     logical(LK),dimension(:),allocatable :: lvec
+    character(kind=CK,len=:),allocatable :: name
 
     write(error_unit,'(A)') ''
     write(error_unit,'(A)') '================================='
@@ -220,6 +221,18 @@ subroutine test_15(error_cnt)
 
         !****************************************
 
+        ! try to get info for an unassociated pointer,
+        ! this should raise an exception:
+        p3 => null()
+        call json%info(p3,var_type,n_children,name)
+        call json%check_for_errors(status_ok)
+        if (status_ok) then
+            error_cnt=error_cnt+1
+            write(error_unit,'(A)') 'Error: info for unassociated pointer'
+        end if
+
+        !****************************************
+
     end if
 
     if (error_cnt>0) then