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 | Intent | Optional | 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. |
| 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 |
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