parse_number Subroutine

private subroutine parse_number(json, unit, str, value)

Read a numerical value from the file (or string). The routine will determine if it is an integer or a real, and allocate the type accordingly.

Note

Complete rewrite of the original FSON routine, which had some problems.

Type Bound

json_core

Arguments

Type IntentOptional Attributes Name
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 :: value

Calls

proc~~parse_number~~CallsGraph proc~parse_number json_core%parse_number proc~json_clear_exceptions json_core%json_clear_exceptions proc~parse_number->proc~json_clear_exceptions proc~pop_char json_core%pop_char proc~parse_number->proc~pop_char proc~push_char json_core%push_char proc~parse_number->proc~push_char proc~string_to_dble json_core%string_to_dble proc~parse_number->proc~string_to_dble proc~string_to_int json_core%string_to_int proc~parse_number->proc~string_to_int proc~to_integer json_core%to_integer proc~parse_number->proc~to_integer proc~to_real json_core%to_real proc~parse_number->proc~to_real none~throw_exception json_core%throw_exception proc~push_char->none~throw_exception proc~integer_to_string integer_to_string proc~push_char->proc~integer_to_string proc~string_to_dble->none~throw_exception proc~string_to_real string_to_real proc~string_to_dble->proc~string_to_real proc~string_to_int->none~throw_exception proc~string_to_integer string_to_integer proc~string_to_int->proc~string_to_integer proc~destroy_json_data destroy_json_data proc~to_integer->proc~destroy_json_data proc~to_real->proc~destroy_json_data proc~json_throw_exception json_core%json_throw_exception none~throw_exception->proc~json_throw_exception proc~wrap_json_throw_exception json_core%wrap_json_throw_exception none~throw_exception->proc~wrap_json_throw_exception proc~wrap_json_throw_exception->none~throw_exception interface~to_unicode to_unicode proc~wrap_json_throw_exception->interface~to_unicode proc~to_uni to_uni interface~to_unicode->proc~to_uni proc~to_uni_vec to_uni_vec interface~to_unicode->proc~to_uni_vec

Called by

proc~~parse_number~~CalledByGraph proc~parse_number json_core%parse_number proc~parse_value json_core%parse_value proc~parse_value->proc~parse_number proc~parse_array json_core%parse_array proc~parse_value->proc~parse_array proc~parse_object json_core%parse_object proc~parse_value->proc~parse_object proc~json_parse_file json_core%json_parse_file proc~json_parse_file->proc~parse_value proc~json_parse_string json_core%json_parse_string proc~json_parse_string->proc~parse_value proc~parse_array->proc~parse_value proc~parse_object->proc~parse_value proc~parse_object->proc~parse_object none~deserialize~2 json_core%deserialize none~deserialize~2->proc~json_parse_string proc~wrap_json_parse_string json_core%wrap_json_parse_string none~deserialize~2->proc~wrap_json_parse_string none~load~2 json_core%load none~load~2->proc~json_parse_file proc~json_file_load json_file%json_file_load proc~json_file_load->none~load~2 proc~json_file_load_from_string json_file%json_file_load_from_string proc~json_file_load_from_string->none~deserialize~2 proc~wrap_json_parse_string->none~deserialize~2 none~deserialize json_file%deserialize none~deserialize->proc~json_file_load_from_string proc~wrap_json_file_load_from_string json_file%wrap_json_file_load_from_string none~deserialize->proc~wrap_json_file_load_from_string proc~assign_string_to_json_file json_file%assign_string_to_json_file proc~assign_string_to_json_file->none~deserialize proc~initialize_json_file_from_string initialize_json_file_from_string proc~initialize_json_file_from_string->none~deserialize proc~initialize_json_file_from_string_v2 initialize_json_file_from_string_v2 proc~initialize_json_file_from_string_v2->none~deserialize proc~wrap_json_file_load_from_string->none~deserialize interface~json_file json_file interface~json_file->proc~initialize_json_file_from_string interface~json_file->proc~initialize_json_file_from_string_v2 proc~wrap_initialize_json_file_from_string wrap_initialize_json_file_from_string interface~json_file->proc~wrap_initialize_json_file_from_string proc~wrap_initialize_json_file_from_string_v2 wrap_initialize_json_file_from_string_v2 interface~json_file->proc~wrap_initialize_json_file_from_string_v2 proc~wrap_assign_string_to_json_file json_file%wrap_assign_string_to_json_file proc~wrap_assign_string_to_json_file->proc~assign_string_to_json_file proc~wrap_initialize_json_file_from_string->proc~initialize_json_file_from_string proc~wrap_initialize_json_file_from_string_v2->proc~initialize_json_file_from_string_v2

Source Code

    subroutine parse_number(json, unit, str, value)

    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            :: value

    character(kind=CK,len=:),allocatable :: tmp !! temp string
    character(kind=CK,len=:),allocatable :: saved_err_message !! temp error message for
                                                              !! string to int conversion
    character(kind=CK,len=1) :: c           !! character returned by [[pop_char]]
    logical(LK)              :: eof         !! end of file flag
    real(RK)                 :: rval        !! real value
    integer(IK)              :: ival        !! integer value
    logical(LK)              :: first       !! first character
    logical(LK)              :: is_integer  !! it is an integer
    integer(IK)              :: ip          !! index to put next character
                                            !! [to speed up by reducing the number
                                            !! of character string reallocations]

    if (.not. json%exception_thrown) then

        tmp = blank_chunk
        ip = 1
        first = .true.
        is_integer = .true.  !assume it may be an integer, unless otherwise determined

        !read one character at a time and accumulate the string:
        do

            !get the next character:
            call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., popped=c)

            select case (c)
            case(CK_'-',CK_'+')    !note: allowing a '+' as the first character here.

                if (is_integer .and. (.not. first)) is_integer = .false.

                !add it to the string:
                !tmp = tmp // c   !...original
                if (ip>len(tmp)) tmp = tmp // blank_chunk
                tmp(ip:ip) = c
                ip = ip + 1

            case(CK_'.',CK_'E',CK_'e',CK_'D',CK_'d')    !can be present in real numbers

                if (is_integer) is_integer = .false.

                !add it to the string:
                !tmp = tmp // c   !...original
                if (ip>len(tmp)) tmp = tmp // blank_chunk
                tmp(ip:ip) = c
                ip = ip + 1

            case(CK_'0':CK_'9')    !valid characters for numbers

                !add it to the string:
                !tmp = tmp // c   !...original
                if (ip>len(tmp)) tmp = tmp // blank_chunk
                tmp(ip:ip) = c
                ip = ip + 1

            case default

                !push back the last character read:
                call json%push_char(c)

                !string to value:
                if (is_integer) then
                    ! it is an integer:
                    ival = json%string_to_int(tmp)

                    if (json%exception_thrown .and. .not. json%strict_integer_type_checking) then
                        ! if it couldn't be converted to an integer,
                        ! then try to convert it to a real value and see if that works

                        saved_err_message = json%err_message  ! keep the original error message
                        call json%clear_exceptions()          ! clear exceptions
                        rval = json%string_to_dble(tmp)
                        if (json%exception_thrown) then
                            ! restore original error message and continue
                            json%err_message = saved_err_message
                            call json%to_integer(value,ival) ! just so we have something
                        else
                            ! in this case, we return a real
                            call json%to_real(value,rval)
                        end if

                    else
                        call json%to_integer(value,ival)
                    end if

                else
                    ! it is a real:
                    rval = json%string_to_dble(tmp)
                    call json%to_real(value,rval)
                end if

                exit    !finished

            end select

            if (first) first = .false.

        end do

        !cleanup:
        if (allocated(tmp)) deallocate(tmp)

    end if

    end subroutine parse_number