parse_object Subroutine

private recursive subroutine parse_object(json, unit, str, parent)

Core parsing routine.

Arguments

Type IntentOptional AttributesName
class(json_core), intent(inout) :: json
integer(kind=IK), intent(in) :: unit

file unit number (if parsing from a file)

character(kind=CK,len=*), intent(in) :: str

JSON string (if parsing from a string)

type(json_value), pointer:: parent

the parsed object will be added as a child of this


Calls

proc~~parse_object~~CallsGraph proc~parse_object parse_object proc~json_value_create json_value_create proc~parse_object->proc~json_value_create

Contents

Source Code


Source Code

    recursive subroutine parse_object(json, unit, str, parent)

    implicit none

    class(json_core),intent(inout)      :: json
    integer(IK),intent(in)              :: unit    !! file unit number (if parsing from a file)
    character(kind=CK,len=*),intent(in) :: str     !! JSON string (if parsing from a string)
    type(json_value),pointer            :: parent  !! the parsed object will be added as a child of this

    type(json_value),pointer :: pair  !! temp variable
    logical(LK)              :: eof   !! end of file flag
    character(kind=CK,len=1) :: c     !! character returned by [[pop_char]]
#if defined __GFORTRAN__
    character(kind=CK,len=:),allocatable :: tmp  !! this is a work-around for a bug
                                                 !! in the gfortran 4.9 compiler.
#endif

    if (.not. json%exception_thrown) then

        !the routine is being called incorrectly.
        if (.not. associated(parent)) then
            call json%throw_exception('Error in parse_object: parent pointer not associated.')
        end if

        nullify(pair)    !probably not necessary

        ! pair name
        call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., &
                            skip_comments=json%allow_comments, popped=c)
        if (eof) then
            call json%throw_exception('Error in parse_object:'//&
                                 ' Unexpected end of file while parsing start of object.')
            return
        else if (end_object == c) then
            ! end of an empty object
            return
        else if (quotation_mark == c) then
            call json_value_create(pair)
#if defined __GFORTRAN__
            call json%parse_string(unit,str,tmp)   ! write to a tmp variable because of
            pair%name = tmp                        ! a bug in 4.9 gfortran compiler.
            deallocate(tmp)
#else
            call json%parse_string(unit,str,pair%name)
#endif
            if (json%exception_thrown) then
                call json%destroy(pair)
                return
            end if
        else
            call json%throw_exception('Error in parse_object: Expecting string: "'//c//'"')
            return
        end if

        ! pair value
        call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., &
                            skip_comments=json%allow_comments, popped=c)
        if (eof) then
            call json%throw_exception('Error in parse_object:'//&
                                 ' Unexpected end of file while parsing object member.')
            return
        else if (colon_char == c) then
            ! parse the value
            call json%parse_value(unit, str, pair)
            if (json%exception_thrown) then
                call json%destroy(pair)
                return
            else
                call json%add(parent, pair)
            end if
        else
            call json%throw_exception('Error in parse_object:'//&
                                      ' Expecting : and then a value: '//c)
            return
        end if

        ! another possible pair
        call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., &
                            skip_comments=json%allow_comments, popped=c)
        if (eof) then
            call json%throw_exception('Error in parse_object: '//&
                                 'End of file encountered when parsing an object')
            return
        else if (delimiter == c) then
            ! read the next member
            call json%parse_object(unit = unit, str=str, parent = parent)
        else if (end_object == c) then
            ! end of object
            return
        else
            call json%throw_exception('Error in parse_object: Expecting end of object: '//c)
            return
        end if

    end if

    end subroutine parse_object