collect_tokens Subroutine

private subroutine collect_tokens(lines, n_lines, li, col, path, tokens, tok_line, n_tok, errors, n_err)

Tokenize a group body up to and including the terminating ‘/’. Token kinds are encoded by their text: “=” , “,” , a quoted or bare value, an identifier, or special markers for unsupported syntax which are flagged here. The ‘/’ ends collection.

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: lines(:)
integer, intent(in) :: n_lines
integer, intent(inout) :: li
integer, intent(inout) :: col
character(len=*), intent(in) :: path
character(len=256), intent(out), allocatable :: tokens(:)
integer, intent(out), allocatable :: tok_line(:)
integer, intent(out) :: n_tok
character(len=:), intent(inout), allocatable :: errors(:)
integer, intent(inout) :: n_err

Calls

proc~~collect_tokens~~CallsGraph proc~collect_tokens collect_tokens proc~add_err add_err proc~collect_tokens->proc~add_err proc~check_unsupported check_unsupported proc~collect_tokens->proc~check_unsupported proc~make_prefix make_prefix proc~collect_tokens->proc~make_prefix proc~push_tok push_tok proc~collect_tokens->proc~push_tok proc~strip_comment strip_comment proc~collect_tokens->proc~strip_comment proc~check_unsupported->proc~add_err proc~check_unsupported->proc~make_prefix proc~is_repeat_count is_repeat_count proc~check_unsupported->proc~is_repeat_count proc~fmt_int fmt_int proc~make_prefix->proc~fmt_int

Called by

proc~~collect_tokens~~CalledByGraph proc~collect_tokens collect_tokens proc~parse_group_body parse_group_body proc~parse_group_body->proc~collect_tokens proc~dispatch_group dispatch_group proc~dispatch_group->proc~parse_group_body proc~parse_from_lines parse_from_lines proc~parse_from_lines->proc~dispatch_group proc~parse_file parse_file proc~parse_file->proc~parse_from_lines proc~schema_parse_lines nml_schema_t%schema_parse_lines proc~schema_parse_lines->proc~parse_from_lines proc~read_config_from_string_impl read_config_from_string_impl proc~read_config_from_string_impl->proc~schema_parse_lines proc~schema_parse nml_schema_t%schema_parse proc~schema_parse->proc~parse_file

Variables

Type Visibility Attributes Name Initial
character(len=1), private :: c
logical, private :: closed
integer, private :: i
character(len=1), private :: q
character(len=:), private, allocatable :: s
integer, private :: slen

Source Code

   subroutine collect_tokens(lines, n_lines, li, col, path, tokens, tok_line, n_tok, errors, n_err)
      !! Tokenize a group body up to and including the terminating '/'.
      !! Token kinds are encoded by their text: "=" , "," , a quoted or
      !! bare value, an identifier, or special markers for unsupported
      !! syntax which are flagged here.  The '/' ends collection.
      character(len=*), intent(in) :: lines(:)
      integer, intent(in) :: n_lines
      integer, intent(inout) :: li, col
      character(len=*), intent(in) :: path
      character(len=256), allocatable, intent(out) :: tokens(:)
      integer, allocatable, intent(out) :: tok_line(:)
      integer, intent(out) :: n_tok
      character(len=:), allocatable, intent(inout) :: errors(:)
      integer, intent(inout) :: n_err

      character(len=:), allocatable :: s
      integer :: i, slen
      logical :: closed
      character :: c, q

      n_tok = 0
      allocate (tokens(32))
      allocate (tok_line(32))
      closed = .false.

      do while (li <= n_lines .and. .not. closed)
         s = strip_comment(lines(li))
         slen = len(s)
         i = col
         do while (i <= slen)
            c = s(i:i)
            if (c == "/") then
               closed = .true.
               col = i + 1
               exit
            end if
            if (c == " " .or. c == achar(9)) then
               i = i + 1
            else if (c == "=") then
               call push_tok(tokens, tok_line, n_tok, "=", li)
               i = i + 1
            else if (c == ",") then
               call push_tok(tokens, tok_line, n_tok, ",", li)
               i = i + 1
            else if (c == '"' .or. c == "'") then
               q = c
               block
                  integer :: j
                  j = i + 1
                  do while (j <= slen)
                     if (s(j:j) == q) exit
                     j = j + 1
                  end do
                  if (j > slen) then
                     call add_err(errors, n_err, make_prefix(path, li)//"unterminated string literal")
                     call push_tok(tokens, tok_line, n_tok, s(i + 1:slen), li)
                     i = slen + 1
                  else
                     call push_tok(tokens, tok_line, n_tok, s(i + 1:j - 1), li)
                     i = j + 1
                  end if
               end block
            else
               ! Bare token: identifier or value, runs to delimiter.
               block
                  integer :: start, j
                  character(len=:), allocatable :: word
                  start = i
                  j = i
                  do while (j <= slen)
                     if (s(j:j) == " " .or. s(j:j) == achar(9) .or. s(j:j) == "=" .or. &
                         s(j:j) == "," .or. s(j:j) == "/") exit
                     j = j + 1
                  end do
                  word = s(start:j - 1)
                  call check_unsupported(word, path, li, errors, n_err)
                  call push_tok(tokens, tok_line, n_tok, word, li)
                  i = j
               end block
            end if
         end do
         if (.not. closed) then
            li = li + 1
            col = 1
         end if
      end do

      if (.not. closed) then
         call add_err(errors, n_err, make_prefix(path, max(li - 1, 1))// &
                      "group not terminated with '/' before end of file")
      end if
   end subroutine collect_tokens