jf_test_10.f90 Source File

!*****************************************************************************************
!> author: Jacob Williams
!  date: 3/10/2015
!
! Module for the tenth unit test.

module jf_test_10_mod

    use json_module
    use, intrinsic :: iso_fortran_env , only: error_unit, output_unit, wp => real64

    implicit none

    character(len=*),parameter :: filename = 'test1.json'
    character(len=*),parameter :: dir = '../files/inputs/' !working directory

contains

    subroutine test_10(error_cnt)

    !! Test some of the lesser-used features of the library

    implicit none

    integer,intent(out) :: error_cnt

    character(kind=json_CK,len=256),dimension(:),allocatable :: str_vec
    type(json_file) :: f,f2
    type(json_value),pointer :: p
    type(json_core) :: json       !! factory for manipulating `json_value` pointers
    character(kind=json_CK,len=:),allocatable :: str,name
    logical :: found,lval
    integer :: var_type,n_children

    character(kind=json_CDK,len=*),parameter :: json_str = '{ "blah": 123 }'

    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 10 '
    write(error_unit,'(A)') '================================='

    write(error_unit,'(A)') ''
    write(error_unit,'(A)') 'Loading file: '//trim(filename)//'...'

    call f%load_file(dir//filename)  ! will call initialize()
    if (f%failed()) then
        call f%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        write(error_unit,'(A)') '...success'
    end if
    write(error_unit,'(A)') ''

    write(error_unit,'(A)') 'json_file_move_pointer...'
    call f2%initialize()
    call f2%move(f)
    if (f2%failed()) then
        call f2%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        write(error_unit,'(A)') '...success'
    end if

    write(error_unit,'(A)') 'json_file_load_from_string...'
    call f%load_from_string(json_str)
    if (f%failed()) then
        call f%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        write(error_unit,'(A)') '...success'
    end if

    write(error_unit,'(A)') 'json_file_print_to_string...'
    call f%print_to_string(str)
    if (f%failed()) then
        call f%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        write(error_unit,'(A)') '...success'
    end if

    write(error_unit,'(A)') 'json_file_variable_info...'
    call f%info('blah',found,var_type,n_children,name)
    if (f%failed()) then
        call f%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        !also make sure the values are correct:
        if (var_type==json_integer .and. n_children==0) then
            write(error_unit,'(A)') '...success'
        else
            write(error_unit,'(A)') 'Error invalid values:',var_type,n_children
            error_cnt = error_cnt + 1
        end if
    end if

    write(error_unit,'(A)') 'json_file_get_logical...'
    call f2%get('data(1).tf1',lval,found)
    if (f2%failed()) then
        call f2%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        !also make sure the values are correct:
        if (found .and. lval) then
            write(error_unit,'(A)') '...success'
        else
            write(error_unit,'(A)') 'Error: incorrect result.'
            error_cnt = error_cnt + 1
        end if
    end if

    ! json_file_get_logical_vec .... [add this]

    write(error_unit,'(A)') 'json_file_get_string_vec...'
    call f2%get('files',str_vec,found)
    if (f2%failed()) then
        call f2%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        !also make sure the values are correct:
        if (found .and. size(str_vec)==6 .and. &
            str_vec(1)=='..\path\to\files\file1.txt') then
            write(error_unit,'(A)') '...success'
        else
            write(error_unit,'(A)') 'Error: incorrect result: '//trim(str_vec(1))
            error_cnt = error_cnt + 1
        end if
    end if

    write(error_unit,'(A)') 'json_file_update_logical [variable present]...'
    call f2%update('data(1).tf1',.false.,found)
    if (f2%failed()) then
        call f2%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        if (found) then
            write(error_unit,'(A)') '...success'
        else
            write(error_unit,'(A)') 'Error: variable was not there.'
            error_cnt = error_cnt + 1
        end if
    end if
    write(error_unit,'(A)') 'json_file_update_logical [variable not present]...'
    call f2%update('new_logical',.true.,found)
    if (f2%failed()) then
        call f2%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        write(error_unit,'(A)') '...success'
    end if

    write(error_unit,'(A)') 'json_file_update_real [variable present]...'
    call f2%update('data[2].real',100.0d0,found)
    if (f2%failed()) then
        call f2%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        if (found) then
            write(error_unit,'(A)') '...success'
        else
            write(error_unit,'(A)') 'Error: variable was not there.'
            error_cnt = error_cnt + 1
        end if
    end if
    write(error_unit,'(A)') 'json_file_update_real [variable not present]...'
    call f2%update('new_real',1776.0d0,found)
    if (f2%failed()) then
        call f2%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        write(error_unit,'(A)') '...success'
    end if

    write(error_unit,'(A)') 'json_file_update_string [variable present]...'
    call f2%update('version.string','10.0.0',found)
    if (f2%failed()) then
        call f2%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        if (found) then
            write(error_unit,'(A)') '...success'
        else
            write(error_unit,'(A)') 'Error: variable was not there.'
            error_cnt = error_cnt + 1
        end if
    end if
    write(error_unit,'(A)') 'json_file_update_string [variable not present]...'
    call f2%update('new_string','foo',found)
    if (f2%failed()) then
        call f2%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        write(error_unit,'(A)') '...success'
    end if

    !--------------------------------

    write(error_unit,'(A)') ''
    write(error_unit,'(A)') 'json_file_get_integer...'
    call f2%get('$',p,found)  !get root
    if (f2%failed()) then
        call f2%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        if (found) then
            write(error_unit,'(A)') '...success'

            write(error_unit,'(A)') 'json_info...'
            call json%info(p,var_type,n_children,name)
            if (json%failed()) then
                call json%print_error_message(error_unit)
                error_cnt = error_cnt + 1
            else
                write(error_unit,'(A)') '...success'
            end if

            write(error_unit,'(A)') 'json_remove_if_present...'
            call json%remove_if_present(p,'version.patch')
            if (json%failed()) then
                call json%print_error_message(error_unit)
                error_cnt = error_cnt + 1
            else
                write(error_unit,'(A)') '...success'
            end if
        else
            write(error_unit,'(A)') 'Error: variable was not there.'
            error_cnt = error_cnt + 1
        end if
    end if

    write(error_unit,'(A)') 'json_update_logical...'
    call json%update(p,'data(1).tf1',.true.,found)
    if (json%failed()) then
        call json%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        if (found) then
            write(error_unit,'(A)') '...success'
        else
            write(error_unit,'(A)') 'Error: variable was not there.'
            error_cnt = error_cnt + 1
        end if
    end if

    write(error_unit,'(A)') 'json_update_double...'
    call json%update(p,'data(2).real',-1.0d0,found)
    if (json%failed()) then
        call json%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        if (found) then
            write(error_unit,'(A)') '...success'
        else
            write(error_unit,'(A)') 'Error: variable was not there.'
            error_cnt = error_cnt + 1
        end if
    end if

    write(error_unit,'(A)') 'json_get_logical...'
    call json%get(p,'data(1).tf1',lval,found)
    if (json%failed()) then
        call json%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        if (found) then
            write(error_unit,'(A)') '...success'
        else
            write(error_unit,'(A)') 'Error: variable was not there.'
            error_cnt = error_cnt + 1
        end if
    end if

    write(error_unit,'(A)') 'json_get_string_vec...'
    call json%get(p,'files',str_vec,found)
    if (json%failed()) then
        call json%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        !also make sure the values are correct:
        if (found .and. size(str_vec)==6 .and. &
            str_vec(1)=='..\path\to\files\file1.txt') then
            write(error_unit,'(A)') '...success'
        else
            write(error_unit,'(A)') 'Error: incorrect result: '//trim(str_vec(1))
            error_cnt = error_cnt + 1
        end if
    end if

    write(error_unit,'(A)') 'json_create...'
    write(error_unit,'(A)') 'json_create_logical...'; call json%destroy(p); call json%create_logical(p,.true.,'foo')
    write(error_unit,'(A)') 'json_create_integer...'; call json%destroy(p); call json%create_integer(p,1000,'foo')
    write(error_unit,'(A)') 'json_create_double ...'; call json%destroy(p); call json%create_double (p,9.0d0,'foo')
    write(error_unit,'(A)') 'json_create_string ...'; call json%destroy(p); call json%create_string (p,'foo','bar')
    write(error_unit,'(A)') 'json_create_null   ...'; call json%destroy(p); call json%create_null   (p,'foo')
    write(error_unit,'(A)') 'json_create_object ...'; call json%destroy(p); call json%create_object (p,'foo')
    if (json%failed()) then
        call json%print_error_message(error_unit)
        error_cnt = error_cnt + 1
    else
        write(error_unit,'(A)') '...success'
    end if

    !--------------------------------

    !cleanup:
    !call f%destroy()   !WARNING: causing "pointer being freed was not allocated" errors.... need to investigate
    !call f2%destroy()

    end subroutine test_10

end module jf_test_10_mod
!*****************************************************************************************

!*****************************************************************************************
program jf_test_10

    !! Tenth unit test.

    use jf_test_10_mod , only: test_10
    implicit none
    integer :: n_errors
    n_errors = 0
    call test_10(n_errors)
    if (n_errors /= 0) stop 1

end program jf_test_10
!*****************************************************************************************