!*****************************************************************************************
!>
! Module for the seventh unit test.
!
!# HISTORY
! * Izaak Beekman : 2/18/2015 : Created (refactoried original json_example.f90 file)
module jf_test_7_mod
use json_module
use, intrinsic :: iso_fortran_env , only: error_unit, output_unit, wp => real64
implicit none
contains
subroutine test_7(error_cnt)
!! Indent test
implicit none
integer,intent(out) :: error_cnt
type(json_value),pointer :: root,a,b,c,d,e,e1,e2,escaped_string,p
logical :: found
character(kind=CK,len=1), dimension(:), allocatable :: strvec
character(kind=CK,len=:), allocatable :: string
found=.false.
error_cnt = 0
call json_initialize()
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
write(error_unit,'(A)') ''
write(error_unit,'(A)') '================================='
write(error_unit,'(A)') ' EXAMPLE 7 : indent test'
write(error_unit,'(A)') '================================='
write(error_unit,'(A)') ''
!-----------------------
! jsonlint indention is
!-----------------------
!{
! "a": {
! "ints": [
! 1,
! 2,
! 3
! ],
! "chars": [
! "a",
! "b",
! "c"
! ]
! },
! "b": {
! "c": {
! "val1": 1066
! }
! },
! "d": {
! "val2": 1815
! },
! "array": [
! {
! "int1": 1
! },
! {
! "int1": 1,
! "int2": 2
! }
! ]
! "escaped string": "\\\/\b\f\n\r\t"
!}
!create a json structure:
call json_create_object(root,'root')
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_create_object(a,'a')
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(a,'ints', [1,2,3])
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_create_object(b,'b')
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(a,'chars', ['a','b','c'])
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_get_child(a,'chars',p)
call json_get(p,strvec)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_create_object(c,'c')
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(c,'val1', 1066)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_create_object(d,'d')
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(d,'val2', 1815)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_create_array(e,'array') !objects in an array
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_create_object(e1,'')
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(e1,'int1', 1)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_create_object(e2,'')
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(e2,'int1', 1)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(e2,'int2', 2)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(e,e1)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(e,e2)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(root,a)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(root,b)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(b,c)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(root,d)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(root,e)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(root,'escaped string',&
'\/'//&
achar(8)//&
achar(12)//&
achar(10)//&
achar(13)//&
achar(9))
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_add(root,'wacky string',['trim ',' and ',' adjust',' left'],&
trim_str=.true.,adjustl_str=.true.)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
nullify(a) !don't need these anymore
nullify(b)
nullify(c)
nullify(d)
nullify(e)
nullify(e1)
nullify(e2)
nullify(escaped_string)
call json_print(root,output_unit) !print to the console
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
! look for the 'escaped string' entry
call json_get(root,'escaped string',escaped_string,found)
if (json_failed() .or. .not. found) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_get(escaped_string,string)
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
write(error_unit,'(A)') "Fetched unescaped 'escaped string': "//string
! remove the escaped string entry
if (found) call json_remove(escaped_string,destroy=.true.)
call json_print(root,error_unit) !print to stderr
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
call json_destroy(root) !cleanup
if (json_failed()) then
call json_print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
end subroutine test_7
end module jf_test_7_mod
!*****************************************************************************************
!*****************************************************************************************
program jf_test_7
!! Seventh unit test.
use jf_test_7_mod , only: test_7
implicit none
integer :: n_errors
n_errors = 0
call test_7(n_errors)
if (n_errors /= 0) stop 1
end program jf_test_7
!*****************************************************************************************
!*******************************************************************************************************