cli_parse_args Subroutine

private subroutine cli_parse_args(this, args, err)

Parse an explicit argument list.

This is the real implementation; parse is a thin collector over it. Taking the arguments as data rather than reading them from the process is what makes every path here testable.

Type Bound

cli_t

Arguments

Type IntentOptional Attributes Name
class(cli_t), intent(inout) :: this
type(string_type), intent(in) :: args(:)

Arguments, excluding the program name.

type(error_t), intent(inout), optional :: err

Set on a parse or validation failure.


Calls

proc~~cli_parse_args~~CallsGraph proc~cli_parse_args cli_t%cli_parse_args proc~cli_find cli_t%cli_find proc~cli_parse_args->proc~cli_find proc~cli_find_short cli_find_short proc~cli_parse_args->proc~cli_find_short proc~fail~2 fail proc~cli_parse_args->proc~fail~2 proc~is_long is_long proc~cli_parse_args->proc~is_long proc~is_short is_short proc~cli_parse_args->proc~is_short proc~looks_numeric looks_numeric proc~cli_parse_args->proc~looks_numeric proc~next_positional next_positional proc~cli_parse_args->proc~next_positional proc~error_set error_t%error_set proc~fail~2->proc~error_set

Called by

proc~~cli_parse_args~~CalledByGraph proc~cli_parse_args cli_t%cli_parse_args proc~cli_parse cli_t%cli_parse proc~cli_parse->proc~cli_parse_args

Variables

Type Visibility Attributes Name Initial
character(len=:), private, allocatable :: arg
integer(kind=default_int), private :: eq
integer(kind=default_int), private :: i
integer(kind=default_int), private :: idx
integer(kind=default_int), private :: n
character(len=:), private, allocatable :: name
logical, private :: options_done
integer(kind=default_int), private :: positional
character(len=:), private, allocatable :: value

Source Code

   subroutine cli_parse_args(this, args, err)
      !! Parse an explicit argument list.
      !!
      !! This is the real implementation; `parse` is a thin collector over it.
      !! Taking the arguments as data rather than reading them from the
      !! process is what makes every path here testable.
      class(cli_t), intent(inout) :: this
      type(string_type), intent(in) :: args(:)
         !! Arguments, excluding the program name.
      type(error_t), intent(inout), optional :: err
         !! Set on a parse or validation failure.

      integer(default_int) :: i, n, idx, eq, positional
      logical :: options_done
      character(len=:), allocatable :: arg, name, value

      this%wants_help = .false.
      this%parsed = .true.
      do i = 1_default_int, this%count
         this%entries(i)%seen = 0_default_int
         this%entries(i)%value = this%entries(i)%default
      end do

      n = size(args, kind=default_int)
      options_done = .false.
      positional = 0_default_int
      i = 1_default_int
      do while (i <= n)
         arg = char(args(i))

         if (.not. options_done .and. arg == "--") then
            options_done = .true.
            i = i + 1_default_int
            cycle
         end if

         if (.not. options_done .and. is_long(arg)) then
            eq = index(arg, "=")
            if (eq > 0) then
               name = arg(3:eq - 1)
               value = arg(eq + 1:)
            else
               name = arg(3:)
               value = ""
            end if

            if (name == "help") then
               this%wants_help = .true.
               i = i + 1_default_int
               cycle
            end if

            idx = this%find(name)
            ! `find` matches every kind, including positionals. A positional
            ! reached as `--name` would be filled without advancing the
            ! positional counter, so the extra-argument check downstream would
            ! not see it and `--scenario a b` would quietly succeed where
            ! `a b` correctly fails.
            if (idx /= 0_default_int) then
               if (this%entries(idx)%kind == KIND_POSITIONAL) idx = 0_default_int
            end if
            if (idx == 0_default_int) then
               call fail(err, ERROR_PARSE, "pic_cli: unknown option --"//name)
               return
            end if
            if (this%entries(idx)%kind == KIND_FLAG) then
               if (eq > 0) then
                  call fail(err, ERROR_PARSE, "pic_cli: flag --"//name//" takes no value")
                  return
               end if
               this%entries(idx)%value = "true"
               this%entries(idx)%seen = this%entries(idx)%seen + 1_default_int
               i = i + 1_default_int
               cycle
            end if
            if (eq == 0) then
               if (i == n) then
                  call fail(err, ERROR_PARSE, "pic_cli: option --"//name//" needs a value")
                  return
               end if
               value = char(args(i + 1_default_int))
               i = i + 1_default_int
            end if
            this%entries(idx)%value = value
            this%entries(idx)%seen = this%entries(idx)%seen + 1_default_int
            i = i + 1_default_int
            cycle
         end if

         if (.not. options_done .and. is_short(arg)) then
            name = arg(2:2)
            if (name == "h") then
               this%wants_help = .true.
               i = i + 1_default_int
               cycle
            end if
            idx = cli_find_short(this, name)
            if (idx == 0_default_int) then
               call fail(err, ERROR_PARSE, "pic_cli: unknown option -"//name)
               return
            end if
            if (this%entries(idx)%kind == KIND_FLAG) then
               this%entries(idx)%value = "true"
               this%entries(idx)%seen = this%entries(idx)%seen + 1_default_int
               i = i + 1_default_int
               cycle
            end if
            if (i == n) then
               call fail(err, ERROR_PARSE, "pic_cli: option -"//name//" needs a value")
               return
            end if
            this%entries(idx)%value = char(args(i + 1_default_int))
            this%entries(idx)%seen = this%entries(idx)%seen + 1_default_int
            i = i + 2_default_int
            cycle
         end if

         ! A dash-prefixed token that matched no option form above is a
         ! mistake, not a positional. Grouped short flags (`-abc`), `-s=5` and
         ! `-s5` are out of scope, and out of scope has to mean rejected:
         ! filing them as positionals turns a typo into the scenario
         ! filename. Negative numbers are the deliberate exception, since they
         ! have to be able to reach a positional.
         if (.not. options_done .and. len(arg) > 1) then
            if (arg(1:1) == "-" .and. .not. looks_numeric(arg)) then
               call fail(err, ERROR_PARSE, "pic_cli: unknown option "//arg)
               return
            end if
         end if

         ! anything else fills the next declared positional
         call next_positional(this, positional, idx)
         if (idx == 0_default_int) then
            call fail(err, ERROR_PARSE, "pic_cli: unexpected argument "//arg)
            return
         end if
         this%entries(idx)%value = arg
         this%entries(idx)%seen = this%entries(idx)%seen + 1_default_int
         i = i + 1_default_int
      end do

      ! A help request short-circuits validation: `--help` alone must work
      ! even though the required positionals are missing, which is exactly
      ! when a user reaches for it.
      if (this%wants_help) return

      do i = 1_default_int, this%count
         if (this%entries(i)%kind /= KIND_POSITIONAL) cycle
         if (.not. this%entries(i)%required) cycle
         if (this%entries(i)%seen > 0_default_int) cycle
         call fail(err, ERROR_VALIDATION, &
                   "pic_cli: missing required argument "//char(this%entries(i)%name))
         return
      end do
   end subroutine cli_parse_args