!***************************************************************************************** !> ! Module for the second unit test. ! !# HISTORY ! * Izaak Beekman : 2/18/2015 : Created (refactoried original json_example.f90 file) module jf_test_2_mod use json_module use, intrinsic :: iso_fortran_env , only: error_unit, output_unit, wp => real64 implicit none character(len=*),parameter :: dir = '../files/' !! working directory character(len=*),parameter :: filename2 = 'test2.json' contains subroutine test_2(error_cnt) !! Populate a JSON structure and write it to a file. implicit none integer,intent(out) :: error_cnt type(json_value),pointer :: p, inp, traj, tmp1, tmp2, p_tmp, p_integer_array, p_clone type(json_core) :: json !! factory for manipulating `json_value` pointers integer :: iunit character(kind=json_CK,len=:),allocatable :: name integer :: ival,ival_clone logical :: found logical :: is_valid character(kind=json_CK,len=:),allocatable :: error_msg write(error_unit,'(A)') '' write(error_unit,'(A)') '=================================' write(error_unit,'(A)') ' EXAMPLE 2' write(error_unit,'(A)') '=================================' write(error_unit,'(A)') '' error_cnt = 0 call json%initialize() if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if !root: call json%create_object(p,dir//filename2) ! create the value and associate the pointer ! add the file name as the name of the overall structure 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)') 'initialize the structure...' !config structure: call json%create_object(inp,'inputs') !an object if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(p, inp) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if !test get_parent: call json%get_parent(inp,tmp1) !will be root call json%get_parent(tmp1,tmp2) !has no parent -> null() !trajectory structure: call json%create_array(traj,'trajectory') !an array if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(p, traj) 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)') 'adding some data to structure...' !add some variables: !input variables: call json%add(inp, 't0', 0.1_wp) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(inp, 'tf', 1.1_wp) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(inp, 'x0', 9999.000_wp) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(inp, 'integer_scalar', 1) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(inp, 'integer_array', [2,4,99]) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(inp, 'names', ['aaa','bbb','ccc']) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(inp, 'logical_scalar', .true.) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(inp, 'logical_vector', [.true., .false., .true.]) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if nullify(inp) !trajectory variables: call add_variables_to_input(json, traj, 'Rx', 'km', 'J2000', 'EARTH', [1.0_wp, 2.0_wp, 3.0_wp], error_cnt ) call add_variables_to_input(json, traj, 'Ry', 'km', 'J2000', 'EARTH', [10.0_wp, 20.0_wp, 30.0_wp], error_cnt ) call add_variables_to_input(json, traj, 'Rz', 'km', 'J2000', 'EARTH', [100.0_wp, 200.0d0, 300.0_wp], error_cnt ) call add_variables_to_input(json, traj, 'Vx', 'km/s', 'J2000', 'EARTH', [1.0e-3_wp, 2.0e-3_wp, 3.0e-3_wp], error_cnt ) call add_variables_to_input(json, traj, 'Vy', 'km/s', 'J2000', 'EARTH', [2.0e-3_wp, 20.0e-3_wp, 3.0e-3_wp], error_cnt ) call add_variables_to_input(json, traj, 'Vz', 'km/s', 'J2000', 'EARTH', [3.0e-3_wp, 30.0e-3_wp, 40.0e-3_wp], error_cnt ) nullify(traj) !validate it: write(error_unit,'(A)') '' write(error_unit,'(A)') 'validating...' call json%validate(p,is_valid,error_msg) if (.not. is_valid) then write(error_unit,'(A)') 'Error: p is not a valid JSON linked list: '//error_msg error_cnt = error_cnt + 1 end if write(error_unit,'(A)') '' write(error_unit,'(A)') 'writing file '//trim(dir//filename2)//'...' open(newunit=iunit, file=dir//filename2, status='REPLACE') call json%print(p,iunit) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if close(iunit) !test the deep copy routine: write(error_unit,'(A)') 'json_clone test' call json%clone(p,p_clone) write(error_unit,'(A)') '' write(error_unit,'(A)') '=============' write(error_unit,'(A)') ' p_clone' write(error_unit,'(A)') '=============' call json%print(p_clone,error_unit) write(error_unit,'(A)') '=============' write(error_unit,'(A)') '' if (.not. associated(p)) write(error_unit,'(A)') 'ERROR: p has become unassociated' if (.not. associated(p_clone)) write(error_unit,'(A)') 'ERROR: p_clone is not associated' if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 else !now, change one and verify that they are independent: call json%update(p_clone,'inputs.integer_scalar',100,found) if (json%failed()) write(error_unit,'(A)') 'json%update Error for p_clone' call json%get(p,'inputs.integer_scalar',ival) if (json%failed()) write(error_unit,'(A)') 'json%get Error for p' call json%get(p_clone,'inputs.integer_scalar',ival_clone) if (json%failed()) write(error_unit,'(A)') 'json%get Error for p_clone' if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 else if (ival==1 .and. ival_clone==100) then write(error_unit,'(A)') 'json%clone ... passed' else write(error_unit,'(A)') 'Error: ival /= ival_clone' error_cnt = error_cnt + 1 end if end if end if !test some of the pointer routines: write(error_unit,'(A)') 'Pointer routine tests' call json%get(p,'inputs.integer_array',p_integer_array) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 else !get parent test: call json%get_parent(p_integer_array,p_tmp) !should be "inputs" call json%info(p_tmp,name=name) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 else if (name=='inputs') then write(error_unit,'(A)') 'json%get_parent ... passed' else write(error_unit,'(A)') 'Error: parent should be "inputs", is actually: '//trim(name) error_cnt = error_cnt + 1 end if end if !get next test: call json%get_next(p_integer_array,p_tmp) !should be "names" call json%info(p_tmp,name=name) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 else if (name=='names') then write(error_unit,'(A)') 'json%get_next ... passed' else write(error_unit,'(A)') 'Error: next should be "names", is actually: '//trim(name) error_cnt = error_cnt + 1 end if end if !get previous test: call json%get_previous(p_integer_array,p_tmp) !should be "integer_scalar" call json%info(p_tmp,name=name) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 else if (name=='integer_scalar') then write(error_unit,'(A)') 'json%get_previous ... passed' else write(error_unit,'(A)') 'Error: next should be "integer_scalar", is actually: '//trim(name) error_cnt = error_cnt + 1 end if end if !get tail test: call json%get_tail(p_integer_array,p_tmp) !should be 99, the last element in the array call json%get(p_tmp,ival) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 else if (ival==99) then write(error_unit,'(A)') 'json%get_tail ... passed' else write(error_unit,'(A,1X,I5)') 'Error: tail value should be 99, is actually: ',ival error_cnt = error_cnt + 1 end if end if end if !cleanup: call json%destroy(p) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if write(error_unit,'(A)') '' end subroutine test_2 subroutine add_variables_to_input(json, me, variable, units, frame, center, rdata, error_cnt) !Used by test_2. implicit none type(json_core),intent(inout) :: json type(json_value),pointer :: me character(len=*),intent(in) :: variable, units, frame, center real(wp),dimension(:),intent(in) :: rdata integer, intent(inout) :: error_cnt type(json_value),pointer :: var !a variable in the trajectory: !initialize: nullify(var) !create the object before data can be added: call json%create_object(var,'') !name does not matter if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if !variable info: call json%add(var, 'VARIABLE',trim(variable)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(var, 'UNITS', trim(units)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(var, 'FRAME', trim(frame)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if call json%add(var, 'CENTER', trim(center)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if !trajectory [vector of reals]: call json%add(var, 'DATA', rdata) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if !add this variable to trajectory structure: call json%add(me, var) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 end if !cleanup: nullify(var) end subroutine add_variables_to_input end module jf_test_2_mod !***************************************************************************************** !***************************************************************************************** program jf_test_2 !! Second unit test. use jf_test_2_mod , only: test_2 implicit none integer :: n_errors n_errors = 0 call test_2(n_errors) if (n_errors /= 0) stop 1 end program jf_test_2 !*****************************************************************************************