| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer, | intent(out) | :: | error_cnt | report number of errors to caller |
subroutine test_20(error_cnt)
implicit none
integer,intent(out) :: error_cnt !! report number of errors to caller
type(json_core) :: json
type(json_value),pointer :: p,new,element,elements,root
logical(lk) :: found,is_valid
integer(IK),dimension(:),allocatable :: iarray
character(kind=CK,len=:),allocatable :: error_msg
character(kind=CK,len=*),parameter :: json_example = '{"x":[1,2,3,4]}'
write(error_unit,'(A)') ''
write(error_unit,'(A)') '================================='
write(error_unit,'(A)') ' TEST 20'
write(error_unit,'(A)') '================================='
write(error_unit,'(A)') ''
error_cnt = 0
call json%parse(p,json_example)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
!insert one in the middle:
nullify(element)
call json%get(p,'x(3)',element) ! get pointer to an array element in the file
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
call json%create_integer(new,33,'') ! create a new element
call json%insert_after(element,new) ! insert new element after x(3)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
call json%get(p,'x',iarray)
if (.not. all(iarray==[1,2,3,33,4])) then
write(error_unit,'(A,1x,*(I2,1X))') 'Error: unexpected output:',iarray
error_cnt = error_cnt + 1
else
write(error_unit,'(A,1x,*(I2,1X))') 'Success:',iarray
end if
end if
end if
!insert one at the end:
nullify(element)
call json%get(p,'x(5)',element) ! get pointer to an array element in the file
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
call json%create_integer(new,44,'') ! create a new element
call json%insert_after(element,new) ! insert new element after x(5)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
call json%get(p,'x',iarray)
if (.not. all(iarray==[1,2,3,33,4,44])) then
write(error_unit,'(A,1x,*(I2,1X))') 'Error: unexpected output:',iarray
error_cnt = error_cnt + 1
else
write(error_unit,'(A,1x,*(I2,1X))') 'Success:',iarray
end if
end if
end if
!now, insert by index:
nullify(element)
call json%get(p,'x',element) ! get pointer to the array itself
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
call json%create_integer(new,22,'') ! create a new element
call json%insert_after(element,2,new) ! insert new element after x(2)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
call json%get(p,'x',iarray)
if (.not. all(iarray==[1,2,22,3,33,4,44])) then
write(error_unit,'(A,1x,*(I2,1X))') 'Error: unexpected output:',iarray
error_cnt = error_cnt + 1
else
write(error_unit,'(A,1x,*(I2,1X))') 'Success:',iarray
end if
end if
end if
! extract a set of elements from one array
! and insert them into another:
nullify(new)
call json%create_object(root,'')
call json%create_array(new,'array')
call json%add(root,new)
call json%add(new,'',100)
call json%add(new,'',101)
call json%add(new,'',102)
call json%get(root,'array',iarray)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json%get_child(new,2,elements)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
call json%insert_after(element,7,elements) ! insert new element after x(7)
call json%get(p,'x',iarray)
if (.not. all(iarray==[1,2,22,3,33,4,44,101,102])) then
write(error_unit,'(A,1x,*(I3,1X))') 'Error: unexpected output:',iarray
error_cnt = error_cnt + 1
else
write(error_unit,'(A,1x,*(I3,1X))') 'Success:',iarray
end if
!also check original list, which should now have only 100
call json%validate(new,is_valid,error_msg)
if (.not. is_valid) then
write(error_unit,'(A)') trim(error_msg)
error_cnt = error_cnt + 1
else
!check contents:
call json%get(root,'array',iarray)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
if (.not. all(iarray==[100])) then
write(error_unit,'(A,1x,*(I3,1X))') 'Error: unexpected output:',iarray
error_cnt = error_cnt + 1
else
write(error_unit,'(A,1x,*(I3,1X))') 'Success:',iarray
end if
end if
end if
end if
call json%validate(p,is_valid,error_msg)
if (.not. is_valid) then
write(error_unit,'(A)') trim(error_msg)
error_cnt = error_cnt + 1
end if
!just in case:
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
end if
! cleanup:
call json%destroy(p)
! now, just a test of the edge case:
! (where p doesn't have a parent)
call json%create_object(p,'root')
call json%create_object(new,'next')
call json%insert_after(p,new)
call json%destroy(p)
write(error_unit,'(A)') ''
write(error_unit,'(A)') '================================='
write(error_unit,'(A)') ''
end subroutine test_20