parse_real_wide Subroutine

private subroutine parse_real_wide(str, value, err)

Core real parser.

The string is validated against an explicit grammar first and only then converted with an F edit descriptor built for the exact field width. List directed input is avoided on purpose, see the module documentation.

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str
real(kind=dp), intent(out) :: value
type(error_t), intent(out) :: err

Calls

proc~~parse_real_wide~~CallsGraph proc~parse_real_wide parse_real_wide interface~strip strip proc~parse_real_wide->interface~strip proc~check_exponent check_exponent proc~parse_real_wide->proc~check_exponent proc~error_has_error error_t%error_has_error proc~parse_real_wide->proc~error_has_error proc~error_set error_t%error_set proc~parse_real_wide->proc~error_set proc~skip_sign skip_sign proc~parse_real_wide->proc~skip_sign proc~strip_char strip_char interface~strip->proc~strip_char proc~strip_string strip_string interface~strip->proc~strip_string proc~check_exponent->proc~error_set proc~check_exponent->proc~skip_sign proc~strip_string->interface~strip

Called by

proc~~parse_real_wide~~CalledByGraph proc~parse_real_wide parse_real_wide proc~parse_real_dp_char parse_real_dp_char proc~parse_real_dp_char->proc~parse_real_wide proc~parse_real_dp_string parse_real_dp_string proc~parse_real_dp_string->proc~parse_real_wide proc~parse_real_sp_char parse_real_sp_char proc~parse_real_sp_char->proc~parse_real_wide interface~parse_real parse_real interface~parse_real->proc~parse_real_dp_char interface~parse_real->proc~parse_real_dp_string interface~parse_real->proc~parse_real_sp_char proc~parse_real_sp_string parse_real_sp_string interface~parse_real->proc~parse_real_sp_string proc~parse_real_sp_string->proc~parse_real_sp_char proc~cli_get_real_dp cli_t%cli_get_real_dp proc~cli_get_real_dp->interface~parse_real proc~cli_get_real_sp cli_t%cli_get_real_sp proc~cli_get_real_sp->interface~parse_real

Variables

Type Visibility Attributes Name Initial
character(len=16), private :: field_format
integer(kind=default_int), private :: n_digits
integer(kind=default_int), private :: pos
logical, private :: seen_point
integer(kind=int32), private :: stat

Fixed width on purpose: iostat takes a default integer, which is int32 regardless of how PIC defines default_int.
character(len=:), private, allocatable :: text

Source Code

   subroutine parse_real_wide(str, value, err)
      !! Core real parser.
      !!
      !! The string is validated against an explicit grammar first and only
      !! then converted with an `F` edit descriptor built for the exact field
      !! width. List directed input is avoided on purpose, see the module
      !! documentation.
      character(len=*), intent(in) :: str
      real(dp), intent(out) :: value
      type(error_t), intent(out) :: err

      character(len=:), allocatable :: text
      character(len=16) :: field_format
      integer(default_int) :: pos, n_digits
      integer(int32) :: stat
         !! Fixed width on purpose: `iostat` takes a default integer, which is
         !! `int32` regardless of how PIC defines `default_int`.
      logical :: seen_point

      value = 0.0_dp
      text = strip(str)
      if (len(text) == 0) then
         call err%set(ERROR_PARSE, "cannot parse an empty string as a real")
         return
      end if

      pos = 1
      call skip_sign(text, pos)

      n_digits = 0
      seen_point = .false.
      do while (pos <= len(text))
         if (index(digits, text(pos:pos)) > 0) then
            n_digits = n_digits + 1
         else if (text(pos:pos) == "." .and. .not. seen_point) then
            seen_point = .true.
         else
            exit
         end if
         pos = pos + 1
      end do

      if (n_digits == 0) then
         call err%set(ERROR_PARSE, "no digits in the mantissa of '"//text//"'")
         return
      end if

      if (pos <= len(text)) then
         call check_exponent(text, pos, err)
         if (err%has_error()) return
      end if

      write (field_format, '("(F",I0,".0)")') len(text)
      read (text, field_format, iostat=stat) value
      ! A failed read leaves `value` undefined, so make it safe to inspect
      ! before the range check below looks at it.
      if (stat /= 0_int32) value = 0.0_dp

      ! Compilers disagree on what an out of range field does: some report a
      ! non zero iostat, others quietly deliver an infinity. Reject both.
      if (stat /= 0_int32 .or. abs(value) > huge(value)) then
         value = 0.0_dp
         call err%set(ERROR_PARSE, "real out of range or not convertible: '"//text//"'")
         return
      end if

   end subroutine parse_real_wide