From c47f67b7cd526031890936f57171c21448301d55 Mon Sep 17 00:00:00 2001 From: takeokunn Date: Mon, 20 Jul 2026 02:29:00 +0900 Subject: [PATCH] chore: prepare cl-cli for its public 0.1.0 release Rounds up the accumulated parser/model hardening and the publication-readiness work into a release-ready state. Verified with 190 passing tests on both SBCL and ECL, and all README code examples executed against the built system. Functional / library: - Add :requires-any-of to make-option ("at least one of" alternatives), with the cli-missing-any-of-options condition, help rendering, and make-app rejection of unsatisfiable specs. - Completion renderers (render-completion / render-{bash,zsh,fish}- completion) now return the script as a string when called with no stream, mirroring the format destination contract; the previous no-stream form wrote to *standard-output* and returned no values, so the documented (write-string (render-completion ...)) pattern was impossible. Passing a stream still writes and returns no values. - Parser/model fixes: attached-value command completion, short-cluster stop-parsing remainder, separated bare "-" optional values, required- after-optional positional rejection, colliding option-key rejection, reserved :help/:version key rejection, post-separator runtime-marker handling, validate-before-intern for option/positional keys, and a per-app relation-rulebase cache that no longer corrupts reused command specs. - Performance: reuse the option-relation Prolog rulebase built at make-app time instead of rebuilding it on every parse-argv call. Publication / non-functional: - Fix broken absolute-path (/Users/...) links in README.md / SUPPORT.md. - Give SECURITY.md a concrete private reporting path (GitHub advisories). - Document the cl-prolog git-dependency install path; a bare ql:quickload cannot resolve cl-cli on its own. - Restructure CHANGELOG.md into Keep a Changelog format. - Add a Public API reference section to README covering previously undocumented entry points (print-app-help, the individual command constructors, runtime-argv helpers, accessors, and conditions). --- CHANGELOG.md | 68 +++++++- README.md | 125 ++++++++++++-- SECURITY.md | 23 +-- SUPPORT.md | 2 +- src/completion-renderers-bash.lisp | 14 +- src/completion-renderers-fish.lisp | 12 +- src/completion-renderers-zsh.lisp | 12 +- src/conditions.lisp | 3 + src/core.lisp | 11 ++ src/help-renderers.lisp | 8 + src/model.lisp | 194 +++++++++++++++------- src/option-relations.lisp | 48 +++++- src/package.lisp | 4 + src/parser-consumption.lisp | 9 +- src/parser-dispatch.lisp | 3 +- src/parser-lookup.lisp | 26 ++- src/parser-option-consumption.lisp | 27 ++- src/runtime.lisp | 28 ++-- tests/cases-completion-bash.lisp | 15 +- tests/cases-completion-commands.lisp | 22 ++- tests/cases-help.lisp | 12 ++ tests/cases-parse.lisp | 41 ++++- tests/cases-validation-relations.lisp | 94 +++++++++++ tests/cases-validation-specification.lisp | 45 +++++ 24 files changed, 720 insertions(+), 126 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7f1da4f..37b8a88 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,68 @@ # Changelog -This project will record user-visible library changes here once tagged releases -begin. +All notable user-visible changes to this project are documented here. -## Unreleased +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), +and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -- Added contributor, support, and release-process documentation. +## [Unreleased] + +### Added + +- `:requires-any-of` on `make-option`: declares that at least one of a set of + alternative options must also be supplied (unlike `:requires`, which demands + all of them). Signals the new `cli-missing-any-of-options` condition and + renders as `requires one of: ...` in help. `make-app` rejects a + `:requires-any-of` whose every alternative conflicts with the option itself, + since such an option could never be validly supplied. +- Contributor, support, and release-process documentation. + +### Changed + +- Completion renderers (`render-completion`, `render-bash-completion`, + `render-zsh-completion`, `render-fish-completion`) now return the generated + script as a string when called without a stream, mirroring the `format` + destination contract; passing a stream still writes to it and returns no + values. Previously the no-stream form wrote to `*standard-output*` and + returned no values, so there was no way to obtain the script as a string + through the public API. - Expanded package metadata for ASDF consumers and package indexes. -- Verified the current test suite on both SBCL and ECL through the Nix flake checks. +- Documented the `cl-prolog` git-dependency install path, since `cl-cli` is not + yet resolvable through a bare Quicklisp `quickload`. +- Option `:requires`/`:conflicts-with` validation now reuses the Prolog + rulebase built once at `make-app` time instead of rebuilding and re-querying + it on every `parse-argv` call. + +### Fixed + +- Bash completion never offered attached-value candidates (`--option=value`) + for command-scoped options. +- A short-option cluster silently dropped characters that followed a + mid-cluster `:stop-parsing-p` flag or boolean instead of surfacing them as + positional input. +- An `:optional-value` option configured with `:consume-optional-value-p t` + could not accept a separated bare `-` (the stdin/stdout idiom) as its value. +- `make-app` no longer accepts a positional sequence with a required positional + after an optional one, since such a spec could never assign the later + positional correctly. +- `make-app` now rejects two options whose keys collide (e.g. case-differing + single-character names like `-a`/`-A`) instead of letting them silently share + one storage slot. +- `make-app` now rejects a user-declared option that reuses the reserved + `:help`/`:version` key, which previously could hijack CLI dispatch into the + help/version action. +- `extract-application-argv`/`application-argv` no longer strip a literal + application argument that happens to match a runtime marker when it appears + after the `--` separator. +- `make-option`/`make-positional` now validate identifier safety before + interning the option/positional key, instead of after. +- A relation rulebase cached on a shared, reused `command-spec` (per the + library's own "reusable command spec" pattern) could be silently overwritten + by a second, unrelated `make-app` call that spliced in the same command + object, corrupting validation for the first app. The cache now lives per-app, + keyed by command object, instead of being stored on the shared command + struct. +- Corrected broken absolute-path documentation links and gave `SECURITY.md` a + concrete private vulnerability-reporting path. + +[Unreleased]: https://github.com/takeokunn/cl-cli/commits/main diff --git a/README.md b/README.md index 882669c..0ee0b68 100644 --- a/README.md +++ b/README.md @@ -14,18 +14,38 @@ minimal Common Lisp and Nix environments. ## Installation -With Quicklisp / ASDF: +`cl-cli` depends on [`cl-prolog`](https://github.com/takeokunn/cl-prolog), which +is **not in Quicklisp**, so a bare `(ql:quickload :cl-cli)` will not resolve on +its own. Choose one of the paths below. -```lisp -(ql:quickload :cl-cli) +### With Nix (recommended) + +The flake wires up `cl-prolog` and `cl-weave` for you: + +```bash +nix develop # drop into a shell with all dependencies available +nix flake check # run the test suite across sbcl and ecl ``` -With Nix: +### With ASDF / Quicklisp + +Clone `cl-cli` and its `cl-prolog` dependency where ASDF can find them (for +example under `~/common-lisp/` or `~/quicklisp/local-projects/`), then load it. +Once the dependency is registered, Quicklisp resolves the remaining `uiop` +dependency automatically: ```bash -nix develop +git clone https://github.com/takeokunn/cl-prolog ~/common-lisp/cl-prolog +git clone https://github.com/takeokunn/cl-cli ~/common-lisp/cl-cli +``` + +```lisp +(ql:quickload :cl-cli) ``` +Running the test suite additionally requires +[`cl-weave`](https://github.com/takeokunn/cl-weave) checked out the same way. + The repository includes Nix checks for both `sbcl` and `ecl`, so `nix flake check` verifies the current test suite across multiple Common Lisp implementations. @@ -123,6 +143,10 @@ Help output is context-sensitive: - app, command, and option names are restricted to safe identifier characters (letters, digits, `-`, `_`, `.`), so author- or config-supplied names cannot inject shell syntax into generated completion scripts +- a required positional may not follow an optional one, and two options may + not resolve to the same key (e.g. via case-differing single-character + names), since either would silently misassign or overwrite parsed values +- an option may not reuse the reserved `:help`/`:version` key - unknown commands and options suggest the nearest known spelling when the typo is close enough - `--version` is only shown in help when the app has a version string @@ -194,6 +218,20 @@ When a relation target points at a hidden option, parsing still honors the relation but generated help omits that hidden target from public metadata, and runtime relationship errors avoid printing the hidden option name. +`:requires` demands every listed target; when only one of several alternatives +must be present (such as authenticating with a token *or* a username and +password), declare `:requires-any-of` instead: + +```lisp +(cl-cli:make-option :name "login" + :kind :flag + :requires-any-of '(:token :username)) +``` + +Parsing signals `cli-missing-any-of-options` when none of the declared +alternatives are supplied, and help lists them as `requires one of: --token, +--username`. + To make a set of options mutually exclusive (at most one may be supplied), splice them through `cl-cli:exclusive-group` instead of hand-writing every pairwise `:conflicts-with`. Each member gains the others as conflicts, so @@ -334,7 +372,7 @@ Use these `cl-cli` features: Existing coverage: -- script tail preservation and separator normalization are exercised in `stop-parsing-option-preserves-remaining-arguments`, `stop-parsing-short-attached-value`, and `stop-parsing-script-mode-can-normalize-opaque-tail` in [tests/run-tests.lisp](/Users/take/ghq/github.com/takeokunn/cl-cli/tests/run-tests.lisp) +- script tail preservation and separator normalization are exercised in `stop-parsing-option-preserves-remaining-arguments`, `stop-parsing-short-attached-value`, and `stop-parsing-script-mode-can-normalize-opaque-tail` in [tests/run-tests.lisp](tests/run-tests.lisp) ### `cl-tmux` @@ -356,7 +394,7 @@ Use these `cl-cli` features: Existing coverage: - attached short value parsing is shown in the `-S/tmp/tmux.sock` example above -- root/default dispatch is exercised in `default-command-dispatches-without-command-token` in [tests/run-tests.lisp](/Users/take/ghq/github.com/takeokunn/cl-cli/tests/run-tests.lisp) +- root/default dispatch is exercised in `default-command-dispatches-without-command-token` in [tests/run-tests.lisp](tests/run-tests.lisp) ### `private-trade-fx` @@ -379,7 +417,7 @@ Use these `cl-cli` features: Existing coverage: - parser-hook validation is demonstrated in the positive-integer example below -- separator-preserving and separator-normalizing flows are covered in [tests/run-tests.lisp](/Users/take/ghq/github.com/takeokunn/cl-cli/tests/run-tests.lisp) +- separator-preserving and separator-normalizing flows are covered in [tests/run-tests.lisp](tests/run-tests.lisp) ### `nshell` @@ -400,16 +438,16 @@ Use these `cl-cli` features: Existing coverage: - root positional parsing is shown in the `script-runner` example above -- root/default dispatch behavior is covered in [tests/run-tests.lisp](/Users/take/ghq/github.com/takeokunn/cl-cli/tests/run-tests.lisp) +- root/default dispatch behavior is covered in [tests/run-tests.lisp](tests/run-tests.lisp) ### Verification path For the four target CLIs above, the remaining migration work is consumer-side spec translation, not new parser primitives in `cl-cli`. -- representative specs for all four migration targets live in [examples/consumer-migrations.lisp](/Users/take/ghq/github.com/takeokunn/cl-cli/examples/consumer-migrations.lisp) +- representative specs for all four migration targets live in [examples/consumer-migrations.lisp](examples/consumer-migrations.lisp) - load the system with ASDF -- run [tests/run-tests.lisp](/Users/take/ghq/github.com/takeokunn/cl-cli/tests/run-tests.lisp) +- run [tests/run-tests.lisp](tests/run-tests.lisp) - if you launch through SBCL, Nix, or a wrapper script, normalize argv first with `application-argv` ## Validation and exit codes @@ -458,6 +496,15 @@ Shell-specific renderers are also available: (cl-cli:render-fish-completion *app*) ``` +Like `format`, these renderers take an optional stream: called with no stream +they return the script as a string, and called with a stream they write to it +and return no values. Pass an explicit stream to avoid building an intermediate +string: + +```lisp +(cl-cli:render-completion *app* "bash" *standard-output*) +``` + If you want standard built-in subcommands, use `cl-cli:make-standard-commands`. It returns `help` and `version` by default; when the app omits a version string, `version` prints just the app name. @@ -500,6 +547,52 @@ Use `:default-command` when a subcommand app should dispatch a command even without an explicit command token. Use root `:positionals` plus a root `:handler` for script-style CLIs such as `SCRIPT [ARGS...]`. +## Public API reference + +All public symbols live in the `cl-cli` package. + +**Spec constructors** — `make-app`, `make-command`, `make-option`, +`make-positional`, `exclusive-group`, `required-exclusive-group`. + +**Built-in commands** — `make-standard-commands` (the aggregate), or the +individual `make-help-command`, `make-version-command`, and +`make-completion-command`. + +**Parsing and dispatch** — `parse-argv` returns an invocation object without +running handlers; `run-app` parses and dispatches, returning a process exit +code. + +**Help** — `print-app-help` and `print-command-help` render help text directly +to a stream, independent of the built-in `help` command. + +**Shell completion** — `render-completion` (shell name as a string) plus the +shell-specific `render-bash-completion`, `render-zsh-completion`, and +`render-fish-completion`. + +**Runtime argv** — `current-process-argv`, `application-argv`, +`extract-application-argv`, `default-runtime-markers`, and +`strip-argv-separators` normalize launcher-inserted tokens and `--` separators. + +**Invocation accessors** — `option-value` and `positional-value` read resolved +values; `invocation-app`, `invocation-command`, `invocation-action`, +`invocation-argv0`, `invocation-raw-argv`, `invocation-global-options`, +`invocation-command-options`, `invocation-positionals`, `invocation-stdout`, +and `invocation-stderr` expose the rest of the parsed invocation. +`command-by-name` resolves a command spec by name or alias. + +**Spec accessors** — every `make-app` / `make-command` / `make-option` / +`make-positional` keyword has a matching reader in the `app-*`, `command-*`, +and `option-*` families (for example `app-commands`, `command-options`, +`option-required-p`). + +**Conditions** — usage errors subclass `cli-usage-error`; specification errors +signal `cli-invalid-specification`. Concrete conditions include +`cli-unknown-option`, `cli-unknown-command`, `cli-missing-option-value`, +`cli-missing-dependent-option`, `cli-missing-any-of-options`, +`cli-conflicting-options`, `cli-missing-positional`, `cli-invalid-option-value`, +`cli-invalid-positional-value`, and `cli-unexpected-argument`, each with +readers such as `cli-error-message` for structured handling. + ## Test ```bash @@ -511,27 +604,27 @@ nix flake check ## Contributing Development workflow, change expectations, and verification requirements are -documented in [CONTRIBUTING.md](/Users/take/ghq/github.com/takeokunn/cl-cli/CONTRIBUTING.md). +documented in [CONTRIBUTING.md](CONTRIBUTING.md). ## Support Usage questions, bug-report expectations, and maintainer support boundaries are -documented in [SUPPORT.md](/Users/take/ghq/github.com/takeokunn/cl-cli/SUPPORT.md). +documented in [SUPPORT.md](SUPPORT.md). ## Changelog User-visible release notes are tracked in -[CHANGELOG.md](/Users/take/ghq/github.com/takeokunn/cl-cli/CHANGELOG.md). +[CHANGELOG.md](CHANGELOG.md). ## Releasing The maintainer release checklist is documented in -[RELEASING.md](/Users/take/ghq/github.com/takeokunn/cl-cli/RELEASING.md). +[RELEASING.md](RELEASING.md). ## Security Private vulnerability handling expectations are documented in -[SECURITY.md](/Users/take/ghq/github.com/takeokunn/cl-cli/SECURITY.md). +[SECURITY.md](SECURITY.md). ## License diff --git a/SECURITY.md b/SECURITY.md index db5e410..1c13ad0 100644 --- a/SECURITY.md +++ b/SECURITY.md @@ -9,16 +9,19 @@ against the latest commit on the default branch. Do not open a public issue for a suspected security problem. -Report it privately to the maintainers with: - -- a description of the issue -- impact and expected attack conditions -- a minimal reproduction if available -- any proposed mitigation or patch - -If you do not have a private contact path yet, establish one before publishing a -release from this repository. Until then, treat the repository as not ready for -private vulnerability intake. +Report it privately through GitHub's private vulnerability reporting: + +1. Go to + (also reachable from the repository's **Security** tab → **Report a + vulnerability**). +2. Include: + - a description of the issue + - impact and expected attack conditions + - a minimal reproduction if available + - any proposed mitigation or patch + +GitHub keeps the report private between you and the maintainers until an +advisory is published. ## Response expectations diff --git a/SUPPORT.md b/SUPPORT.md index 21e1533..1bc76f2 100644 --- a/SUPPORT.md +++ b/SUPPORT.md @@ -30,7 +30,7 @@ includes: ## Security issues Do not use public issues for suspected vulnerabilities. Follow -[SECURITY.md](/Users/take/ghq/github.com/takeokunn/cl-cli/SECURITY.md). +[SECURITY.md](SECURITY.md). ## Maintenance expectations diff --git a/src/completion-renderers-bash.lisp b/src/completion-renderers-bash.lisp index 094eac1..1c2dc04 100644 --- a/src/completion-renderers-bash.lisp +++ b/src/completion-renderers-bash.lisp @@ -54,7 +54,7 @@ (format out " case \"${words[1]}\" in~%") (format out " ~A)~%" (%completion-case-labels (%completion-command-names command))) - (format out " case \"$cur\" in~%") + (format out " case \"~A:$cur\" in~%" command-name) (write-string (%completion-bash-value-case-body options :command-name command-name) out) @@ -75,9 +75,15 @@ (format out " esac~%")))) (defun render-bash-completion (app &optional stream) - "Render a bash completion script." - (let ((stream (or stream *standard-output*)) - (function-name (%completion-function-name app)) + "Render a bash completion script. + +With no STREAM, return the completion script as a string. With a STREAM, +write the script to it and return no values." + (unless stream + (return-from render-bash-completion + (with-output-to-string (string-stream) + (render-bash-completion app string-stream)))) + (let ((function-name (%completion-function-name app)) (app-name (app-name app))) (format stream "#!/usr/bin/env bash~%") (format stream "# bash completion for ~A~%" app-name) diff --git a/src/completion-renderers-fish.lisp b/src/completion-renderers-fish.lisp index 587dc94..a8d7f8d 100644 --- a/src/completion-renderers-fish.lisp +++ b/src/completion-renderers-fish.lisp @@ -1,9 +1,15 @@ (in-package :cl-cli) (defun render-fish-completion (app &optional stream) - "Render a fish completion script." - (let ((stream (or stream *standard-output*)) - (app-name (app-name app))) + "Render a fish completion script. + +With no STREAM, return the completion script as a string. With a STREAM, +write the script to it and return no values." + (unless stream + (return-from render-fish-completion + (with-output-to-string (string-stream) + (render-fish-completion app string-stream)))) + (let ((app-name (app-name app))) (format stream "complete -c ~A -f~%" (%completion-shell-quote app-name)) (dolist (command (%completion-visible-commands app)) (format stream "complete -c ~A -n ~A -a ~A -d ~A~%" diff --git a/src/completion-renderers-zsh.lisp b/src/completion-renderers-zsh.lisp index 31ef725..c6800c9 100644 --- a/src/completion-renderers-zsh.lisp +++ b/src/completion-renderers-zsh.lisp @@ -36,9 +36,15 @@ (format out " ;;~%")))) (defun render-zsh-completion (app &optional stream) - "Render a zsh completion script." - (let ((stream (or stream *standard-output*)) - (function-name (%completion-function-name app)) + "Render a zsh completion script. + +With no STREAM, return the completion script as a string. With a STREAM, +write the script to it and return no values." + (unless stream + (return-from render-zsh-completion + (with-output-to-string (string-stream) + (render-zsh-completion app string-stream)))) + (let ((function-name (%completion-function-name app)) (app-name (app-name app))) (format stream "#compdef ~A~%" app-name) (format stream "~A() {~%" function-name) diff --git a/src/conditions.lisp b/src/conditions.lisp index 560deb7..cb3365b 100644 --- a/src/conditions.lisp +++ b/src/conditions.lisp @@ -24,6 +24,9 @@ (define-condition cli-missing-dependent-option (cli-usage-error) ((option :initarg :option :reader cli-missing-dependent-option-name) (dependency :initarg :dependency :reader cli-missing-dependent-option-dependency))) +(define-condition cli-missing-any-of-options (cli-usage-error) + ((option :initarg :option :reader cli-missing-any-of-options-name) + (alternatives :initarg :alternatives :reader cli-missing-any-of-options-alternatives))) (define-condition cli-conflicting-options (cli-usage-error) ((left-option :initarg :left-option :reader cli-conflicting-options-left-option) (right-option :initarg :right-option :reader cli-conflicting-options-right-option))) diff --git a/src/core.lisp b/src/core.lisp index 554d92c..4a8079f 100644 --- a/src/core.lisp +++ b/src/core.lisp @@ -66,6 +66,17 @@ (or (= (length token) 2) (not (char= (char token 1) #\-))))) +(defun option-like-token-p (token) + "True when TOKEN would itself be parsed as a long or short option. + +Unlike COMMAND-LINE-OPTION-P (which only checks for a leading \"-\"), this +excludes a bare \"-\": that token is the stdin/stdout idiom and is never +itself parsed as an option (see SHORT-OPTION-TOKEN-P), so a following +optional-value option must be able to consume it as a value instead of +treating it as \"looks like another option, stop here\"." + (or (long-option-token-p token) + (short-option-token-p token))) + (defun stable-sort-copy (sequence predicate &key key) (sort (copy-seq sequence) predicate :key key)) diff --git a/src/help-renderers.lisp b/src/help-renderers.lisp index da6c863..dfaa20e 100644 --- a/src/help-renderers.lisp +++ b/src/help-renderers.lisp @@ -69,6 +69,14 @@ (mapcar #'option-relation-target-display-name visible-requires)) parts))) + (let ((visible-requires-any-of (%public-relation-targets + option options + (option-requires-any-of option)))) + (when visible-requires-any-of + (push (format nil "requires one of: ~{~A~^, ~}" + (mapcar #'option-relation-target-display-name + visible-requires-any-of)) + parts))) ;; Conflicts among members of this option's own group are already conveyed by ;; the "one of" line above; only surface conflicts with options outside it. (let ((visible-conflicts diff --git a/src/model.lisp b/src/model.lisp index 9b9f129..26829a1 100644 --- a/src/model.lisp +++ b/src/model.lisp @@ -16,6 +16,7 @@ parser required-p requires + requires-any-of conflicts-with multiple-p default-present-p @@ -61,7 +62,17 @@ default-command handler examples - help-footer) + help-footer + global-relation-rulebase + ;; A COMMAND-SPEC is an explicitly reusable, composable object (README: + ;; "reusable app, command, option, and positional specs") -- the same + ;; instance can be spliced into :COMMANDS for more than one MAKE-APP call. + ;; Caching a command's relation rulebase ON the shared command struct would + ;; let a later MAKE-APP call silently overwrite the rulebase an earlier, + ;; already-in-use app depends on. Keyed by command object (EQ) instead, this + ;; table lives on the APP -- which is never itself shared as another app's + ;; input -- so each app owns an independent cache even when commands are. + (command-relation-rulebases (make-hash-table :test 'eq))) (defstruct (invocation (:constructor %make-invocation) @@ -110,12 +121,15 @@ (defun validate-option-relationships-declared (specs) (dolist (spec specs) (%validate-related-option-targets specs spec "requires" (option-requires spec)) + (%validate-related-option-targets specs spec "requires-any-of" + (option-requires-any-of spec)) (%validate-related-option-targets specs spec "conflicts-with" (option-conflicts-with spec))) (validate-option-relation-graph specs)) (defun make-option (&key key name short aliases kind description value-name (default nil default-supplied-p) env-var env-vars choices completion-candidates parser required-p requires + requires-any-of conflicts-with multiple-p consume-optional-value-p stop-parsing-p hidden-p) "Create a parsed option specification. @@ -123,62 +137,68 @@ NAME is the long option name without leading dashes. SHORT may be a single character or short-name string. ALIASES is a list of additional option names." (let* ((names (normalize-option-names name short aliases)) - (names-present-p (not (null names))) - (resolved-key (or key - (option-keyword (or name (first names))))) - (resolved-kind (or kind (if multiple-p :value :flag))) - (resolved-value-name (and value-name (princ-to-string value-name))) - (resolved-negated-names - (normalize-negated-option-names resolved-kind names)) - (resolved-env-vars (normalize-env-vars env-var env-vars)) - (resolved-choices (normalize-option-choices choices)) - (resolved-completion-candidates - (normalize-option-completion-candidates completion-candidates)) - (resolved-requires (normalize-option-relations requires)) - (resolved-conflicts-with (normalize-option-relations conflicts-with)) - (resolved-parser (or parser - (ecase resolved-kind - (:flag (lambda (value) - (declare (ignore value)) - t)) - (:boolean (let ((display-name - (if (= (length (first names)) 1) - (format nil "-~A" (first names)) - (format nil "--~A" (first names))))) - (lambda (value) - (parse-boolean-designator value - display-name - resolved-key)))) - (:value #'identity) - (:optional-value #'identity)))) - (default-present-p default-supplied-p)) + (names-present-p (not (null names)))) (unless names-present-p (signal-cli-error 'cli-invalid-specification "An option needs at least one name.")) (validate-non-empty-strings names "Option names") + ;; Validate before OPTION-KEYWORD interns a symbol below: a spec that's + ;; about to be rejected must not leak a permanent :KEYWORD-package symbol + ;; for every rejected name an embedder tries (e.g. building specs from + ;; untrusted plugin/config data and catching CLI-INVALID-SPECIFICATION). (validate-safe-identifier-names names "Option names") - (when resolved-value-name - (validate-non-empty-strings (list resolved-value-name) "Option value names")) - (validate-option-multiplicity resolved-kind multiple-p) - (%make-option-spec :key resolved-key - :names names - :negated-names resolved-negated-names - :kind resolved-kind - :description (normalize-positional-description description) - :value-name resolved-value-name - :default default - :env-vars resolved-env-vars - :choices resolved-choices - :completion-candidates resolved-completion-candidates - :parser resolved-parser - :required-p required-p - :requires resolved-requires - :conflicts-with resolved-conflicts-with - :multiple-p multiple-p - :default-present-p default-present-p - :consume-optional-value-p consume-optional-value-p - :stop-parsing-p stop-parsing-p - :hidden-p hidden-p))) + (let* ((resolved-key (or key + (option-keyword (or name (first names))))) + (resolved-kind (or kind (if multiple-p :value :flag))) + (resolved-value-name (and value-name (princ-to-string value-name))) + (resolved-negated-names + (normalize-negated-option-names resolved-kind names)) + (resolved-env-vars (normalize-env-vars env-var env-vars)) + (resolved-choices (normalize-option-choices choices)) + (resolved-completion-candidates + (normalize-option-completion-candidates completion-candidates)) + (resolved-requires (normalize-option-relations requires)) + (resolved-requires-any-of (normalize-option-relations requires-any-of)) + (resolved-conflicts-with (normalize-option-relations conflicts-with)) + (resolved-parser (or parser + (ecase resolved-kind + (:flag (lambda (value) + (declare (ignore value)) + t)) + (:boolean (let ((display-name + (if (= (length (first names)) 1) + (format nil "-~A" (first names)) + (format nil "--~A" (first names))))) + (lambda (value) + (parse-boolean-designator value + display-name + resolved-key)))) + (:value #'identity) + (:optional-value #'identity)))) + (default-present-p default-supplied-p)) + (when resolved-value-name + (validate-non-empty-strings (list resolved-value-name) "Option value names")) + (validate-option-multiplicity resolved-kind multiple-p) + (%make-option-spec :key resolved-key + :names names + :negated-names resolved-negated-names + :kind resolved-kind + :description (normalize-positional-description description) + :value-name resolved-value-name + :default default + :env-vars resolved-env-vars + :choices resolved-choices + :completion-candidates resolved-completion-candidates + :parser resolved-parser + :required-p required-p + :requires resolved-requires + :requires-any-of resolved-requires-any-of + :conflicts-with resolved-conflicts-with + :multiple-p multiple-p + :default-present-p default-present-p + :consume-optional-value-p consume-optional-value-p + :stop-parsing-p stop-parsing-p + :hidden-p hidden-p)))) (defstruct (option-group (:constructor %make-option-group)) "A set of options that participate together in an exclusive-choice relationship." @@ -232,6 +252,12 @@ supplied, so callers must choose precisely one." (zerop (length (ensure-string name)))) (signal-cli-error 'cli-invalid-specification "A positional name must be non-empty.")) + ;; Validate before OPTION-KEYWORD interns a symbol below: see the matching + ;; comment in MAKE-OPTION. Only applies when NAME derives the key -- an + ;; explicit KEY is already a keyword the caller chose directly in code, not + ;; a string, so there is nothing to validate or intern here. + (when (and (null key) name) + (validate-safe-identifier-names (list (ensure-string name)) "Positional name")) (let ((resolved-key (or key (option-keyword name))) (spec (%make-positional-spec))) @@ -271,6 +297,39 @@ supplied, so callers must choose precisely one." (loop for name in (option-negated-names spec) collect (list name t)))) +(defun %validate-user-option-keys (specs owner-name) + "Reject a user-declared option whose resolved key is :HELP or :VERSION. + +BUILT-IN-OPTION-P and BUILT-IN-OPTION-ACTION (src/model-helpers.lisp, +src/parser-values.lisp) key off OPTION-KEY's value alone, not object identity +with the real built-in spec -- an ordinary option given :KEY :HELP or +:KEY :VERSION would silently force the :HELP/:VERSION dispatch action +whenever it is parsed, regardless of its own :KIND." + (dolist (spec specs) + (when (member (option-key spec) '(:help :version)) + (signal-cli-error 'cli-invalid-specification + (format nil "Option ~A for ~A cannot use the reserved key ~S." + (%option-display-name spec) + owner-name + (option-key spec)))))) + +(defun %validate-option-key-uniqueness (specs owner-name) + "Reject two options in SPECS that resolve to the same OPTION-KEY. + +Distinct declared names can still collide on key -- OPTION-KEYWORD downcases +its argument, so single-character names \"-a\" and \"-A\" (deliberately +case-sensitive as CLI tokens; see CANONICAL-OPTION-NAME) both resolve to +:A. A key collision means the two specs share one storage slot in the parsed +values plist, silently overwriting each other, and only the last spec with +that key survives :requires/:conflicts-with resolution." + (let ((table (make-hash-table :test 'eq))) + (dolist (spec specs) + (%register-table-entry table + (option-key spec) + t + (format nil "option key for ~A" owner-name) + (format nil "~S" (option-key spec)))))) + (defun %validate-option-table (specs) (let ((table (make-hash-table :test 'equal))) (dolist (spec specs specs) @@ -301,7 +360,8 @@ supplied, so callers must choose precisely one." (defun %validate-positional-sequence (positionals owner-name) (let ((seen-keys (make-hash-table :test 'eq)) - (rest-seen-p nil)) + (rest-seen-p nil) + (optional-seen-p nil)) (dolist (spec positionals positionals) (let ((key (positional-spec-key spec))) (when (gethash key seen-keys) @@ -314,6 +374,17 @@ supplied, so callers must choose precisely one." (signal-cli-error 'cli-invalid-specification (format nil "Rest positional for ~A must be last." owner-name))) + ;; Tokens are assigned to positionals greedily in declared order with no + ;; backtracking (APPLY-POSITIONAL-SPEC), so a required positional after + ;; an optional one can never receive a value: the optional one consumes + ;; it first, then the required one fails as "missing" even though a + ;; value was supplied. + (if (positional-spec-required-p spec) + (when optional-seen-p + (signal-cli-error 'cli-invalid-specification + (format nil "Required positional for ~A must not follow an optional positional." + owner-name))) + (setf optional-seen-p t)) (when (positional-spec-rest-p spec) (setf rest-seen-p t))))) @@ -323,16 +394,27 @@ supplied, so callers must choose precisely one." (command-table (%validate-command-table (app-commands app)))) (%validate-positional-sequence (app-positionals app) (app-name app)) - (validate-option-relationships-declared global-specs) + (%validate-user-option-keys (app-global-options app) (app-name app)) + (multiple-value-bind (validated-global-specs global-rulebase) + (validate-option-relationships-declared global-specs) + (declare (ignore validated-global-specs)) + (setf (app-global-relation-rulebase app) global-rulebase)) (%validate-option-table global-specs) + (%validate-option-key-uniqueness global-specs (app-name app)) (dolist (command (app-commands app)) (%validate-positional-sequence (command-positionals command) (command-name command)) + (%validate-user-option-keys (command-options command) (command-name command)) (let ((command-specs (append built-ins (app-global-options app) (command-options command)))) - (validate-option-relationships-declared command-specs) - (%validate-option-table command-specs))) + (multiple-value-bind (validated-command-specs command-rulebase) + (validate-option-relationships-declared command-specs) + (declare (ignore validated-command-specs)) + (setf (gethash command (app-command-relation-rulebases app)) + command-rulebase)) + (%validate-option-table command-specs) + (%validate-option-key-uniqueness command-specs (command-name command)))) (when (and (app-default-command app) (null (gethash (app-default-command app) command-table))) (signal-cli-error 'cli-invalid-specification diff --git a/src/option-relations.lisp b/src/option-relations.lisp index bc4130b..8ccf597 100644 --- a/src/option-relations.lisp +++ b/src/option-relations.lisp @@ -6,6 +6,8 @@ (list (cl-prolog:make-clause '(:requires ?x ?y) '((cl-prolog:fail))) + (cl-prolog:make-clause '(:requires-any ?x ?y) + '((cl-prolog:fail))) (cl-prolog:make-clause '(:conflicts ?x ?y) '((cl-prolog:fail))) (cl-prolog:make-clause '(:requires-transitive ?x ?y) @@ -30,6 +32,12 @@ rulebase (cl-prolog:make-clause (list :requires (option-key spec) (option-key dependency)))))) + (dolist (target (option-requires-any-of spec)) + (let ((alternative (resolve-related-option-spec specs target))) + (cl-prolog:rulebase-insert-clause! + rulebase + (cl-prolog:make-clause + (list :requires-any (option-key spec) (option-key alternative)))))) (dolist (target (option-conflicts-with spec)) (let ((other (resolve-related-option-spec specs target))) (cl-prolog:rulebase-insert-clause! @@ -59,7 +67,27 @@ (setf (gethash key visited) t))))))) (some #'visit specs)))) +(defun %requires-any-of-unsatisfiable-p (spec specs rulebase) + "True when every one of SPEC's :REQUIRES-ANY-OF alternatives conflicts with it. + +If so, SPEC could never be validly supplied: alone it fails the any-of +requirement, and paired with any alternative it fails a :conflicts check." + (let ((alternatives (option-requires-any-of spec))) + (and alternatives + (every (lambda (target) + (let ((other (resolve-related-option-spec specs target))) + (cl-prolog:prolog-succeeds-p + rulebase + (list :conflicts (option-key spec) (option-key other))))) + alternatives)))) + (defun validate-option-relation-graph (specs) + "Validate SPECS' :requires/:conflicts graph and return (values specs rulebase). + +The rulebase built here to check for conflicting closures is exactly the one +parse-time validation needs again for transitive :requires lookups. Returning +it lets callers cache it on the app/command spec instead of rebuilding an +equivalent rulebase from scratch on every PARSE-ARGV call." (when (option-requirement-cycle-p specs) (signal-cli-error 'cli-invalid-specification "Option requirements must not contain a cycle.")) @@ -69,7 +97,13 @@ (signal-cli-error 'cli-invalid-specification "An option requirement closure contains conflicting options.")) - specs)) + (dolist (spec specs) + (when (%requires-any-of-unsatisfiable-p spec specs rulebase) + (signal-cli-error + 'cli-invalid-specification + (format nil "Option ~A's :requires-any-of alternatives all conflict with it, so it could never be satisfied." + (%option-display-name spec))))) + (values specs rulebase))) (defun transitive-required-option-keys (rulebase option-key) (mapcar (lambda (solution) @@ -77,3 +111,15 @@ (cl-prolog:query-prolog rulebase (list :requires-transitive option-key '?dependency)))) + +(defun any-of-required-option-keys (rulebase option-key) + "Return OPTION-KEY's declared :REQUIRES-ANY-OF alternatives, or NIL. + +Unlike :REQUIRES (an AND of individually-mandatory dependencies), satisfying +any single alternative here is sufficient -- callers check presence of at +least one of the returned keys, they do not walk a transitive closure." + (mapcar (lambda (solution) + (cl-prolog:solution-binding '?alternative solution)) + (cl-prolog:query-prolog + rulebase + (list :requires-any option-key '?alternative)))) diff --git a/src/package.lisp b/src/package.lisp index 3902ef8..107790c 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -70,6 +70,7 @@ :option-parser :option-required-p :option-requires + :option-requires-any-of :option-conflicts-with :option-multiple-p :option-consume-optional-value-p @@ -80,6 +81,7 @@ :cli-unknown-command :cli-missing-option-value :cli-missing-dependent-option + :cli-missing-any-of-options :cli-conflicting-options :cli-missing-positional :cli-invalid-option-value @@ -94,6 +96,8 @@ :cli-missing-option-value-name :cli-missing-dependent-option-name :cli-missing-dependent-option-dependency + :cli-missing-any-of-options-name + :cli-missing-any-of-options-alternatives :cli-conflicting-options-left-option :cli-conflicting-options-right-option :cli-missing-positional-name diff --git a/src/parser-consumption.lisp b/src/parser-consumption.lisp index eb490c0..c783fdc 100644 --- a/src/parser-consumption.lisp +++ b/src/parser-consumption.lisp @@ -38,7 +38,8 @@ (scan))))) (defun parse-mixed-arguments (app tokens option-specs positional-specs - &optional initial-option-values) + &optional initial-option-values + &key command) (multiple-value-bind (validated-specs table) (prepare-option-parser-state app option-specs) (let* ((option-values initial-option-values) @@ -91,6 +92,10 @@ (setf option-values (apply-option-defaults option-values validated-specs)) (unless (member action '(:help :version)) (validate-required-options option-values validated-specs) - (validate-option-relationships option-values validated-specs) + (validate-option-relationships + option-values validated-specs + (if command + (gethash command (app-command-relation-rulebases app)) + (app-global-relation-rulebase app))) (validate-required-option-groups option-values validated-specs)) (values option-values positional-values action)))) diff --git a/src/parser-dispatch.lisp b/src/parser-dispatch.lisp index bd4862b..98af941 100644 --- a/src/parser-dispatch.lisp +++ b/src/parser-dispatch.lisp @@ -60,7 +60,8 @@ (append (app-global-options app) (command-options command)) (command-positionals command) - global-values) + global-values + :command command) (let ((resolved-global-options (merge-global-options app combined-option-values global-values)) (resolved-command-options diff --git a/src/parser-lookup.lisp b/src/parser-lookup.lisp index c770562..c8d7319 100644 --- a/src/parser-lookup.lisp +++ b/src/parser-lookup.lisp @@ -1,16 +1,22 @@ (in-package :cl-cli) -(defun validate-option-relationships (values specs) +(defun validate-option-relationships (values specs &optional rulebase) ;; Most CLIs declare no requires/conflicts at all. Skip building a rulebase ;; and running any Prolog proof search when there is nothing to validate -- ;; otherwise every parse pays for a rulebase plus O(present log present) empty ;; queries that can only ever succeed vacuously. (unless (some (lambda (spec) (or (option-requires spec) + (option-requires-any-of spec) (option-conflicts-with spec))) specs) (return-from validate-option-relationships values)) - (let* ((rulebase (make-option-relation-rulebase specs)) + ;; SPECS' :requires/:conflicts graph is fixed at spec-construction time, so + ;; %VALIDATE-APP-SPEC already built and validated this exact rulebase once + ;; and cached it on the app/command spec. Callers pass it in via RULEBASE; + ;; only rebuild here as a fallback for callers validating an ad hoc SPECS + ;; list that was never run through MAKE-APP. + (let* ((rulebase (or rulebase (make-option-relation-rulebase specs))) (present-specs (remove-if-not (lambda (spec) (plist-has-key-p values (option-key spec))) @@ -59,6 +65,22 @@ (public-option-display-name dependency))) :option (option-key spec) :dependency (option-key dependency))))) + (when (option-requires-any-of spec) + (let* ((alternative-keys (any-of-required-option-keys rulebase (option-key spec))) + (alternatives (mapcar (lambda (key) (gethash key spec-by-key)) + alternative-keys))) + (unless (some (lambda (alternative) + (plist-has-key-p values (option-key alternative))) + alternatives) + (signal-cli-error 'cli-missing-any-of-options + (if (option-hidden-p spec) + (format nil "A hidden option requires one of: ~{~A~^, ~}." + (mapcar #'public-option-display-name alternatives)) + (format nil "Option ~A requires one of: ~{~A~^, ~}." + (public-option-display-name spec) + (mapcar #'public-option-display-name alternatives))) + :option (option-key spec) + :alternatives (mapcar #'option-key alternatives))))) (dolist (target (option-conflicts-with spec)) (let ((other (resolve-related-option-spec specs target))) (when (plist-has-key-p values (option-key other)) diff --git a/src/parser-option-consumption.lisp b/src/parser-option-consumption.lisp index a8ca64b..d498d1a 100644 --- a/src/parser-option-consumption.lisp +++ b/src/parser-option-consumption.lisp @@ -43,7 +43,7 @@ (and (eq (option-kind spec) :optional-value) (option-consume-optional-value-p spec) tokens - (not (command-line-option-p (first tokens))))) + (not (option-like-token-p (first tokens))))) (raw (cond (attached attached) (consume-separated-optional-p (first tokens)) @@ -61,6 +61,21 @@ (setf tokens (rest tokens))) (values values tokens action (option-stop-parsing-p spec)))) +(defun %prepend-short-cluster-remainder (cluster index tokens) + "Preserve unconsumed characters after a stop-parsing flag/boolean at INDEX. + +A stop-parsing flag/boolean has no value of its own to absorb the rest of the +cluster the way :VALUE/:OPTIONAL-VALUE options do, so without this the +remaining characters (e.g. \"b\" in \"-xb\" when \"-x\" stops parsing) were +silently discarded instead of surfacing as literal input. Parsing already +switches to literal mode once stop-parsing fires, so the exact spelling only +affects the stored value, not control flow; the leading \"-\" is restored so +the token reflects what was actually typed." + (let ((rest (subseq cluster (1+ index)))) + (if (plusp (length rest)) + (cons (format nil "-~A" rest) tokens) + tokens))) + (defun consume-short-cluster (cluster tokens specs table values action) (loop for index from 0 below (length cluster) do (let* ((name (string (char cluster index))) @@ -74,13 +89,17 @@ (store-flag-option values spec action)) (when (option-stop-parsing-p spec) (return-from consume-short-cluster - (values values tokens action t)))) + (values values + (%prepend-short-cluster-remainder cluster index tokens) + action t)))) (:boolean (multiple-value-setq (values action) (store-boolean-option-value values spec action nil)) (when (option-stop-parsing-p spec) (return-from consume-short-cluster - (values values tokens action t)))) + (values values + (%prepend-short-cluster-remainder cluster index tokens) + action t)))) (:optional-value (let* ((rest (subseq cluster (1+ index))) (attached (and (> (length rest) 0) rest)) @@ -88,7 +107,7 @@ (and (null attached) (option-consume-optional-value-p spec) tokens - (not (command-line-option-p (first tokens))))) + (not (option-like-token-p (first tokens))))) (raw (cond (attached attached) (consume-separated-optional-p (first tokens)) diff --git a/src/runtime.lisp b/src/runtime.lisp index 644ae4e..72d6c70 100644 --- a/src/runtime.lisp +++ b/src/runtime.lisp @@ -56,26 +56,24 @@ must not depend on the Lisp implementation currently running this library." (nthcdr (1+ marker-index) argv) argv))) -(defun %after-separator (argv separator) - (let ((tail (member separator argv :test #'string=))) - (if tail - (rest tail) - argv))) - (defun extract-application-argv (&key (argv (current-process-argv)) runtime-markers separator) "Extract application argv from launcher/runtime ARGV. -If RUNTIME-MARKERS is non-NIL, drop everything through the last matching -marker. If SEPARATOR is non-NIL and present afterwards, return only the tokens -following the first matching separator." - (let ((remaining (copy-list argv))) - (when runtime-markers - (setf remaining (%drop-through-last-marker remaining runtime-markers))) - (if separator - (%after-separator remaining separator) - remaining))) +If SEPARATOR is present in ARGV, everything after its first occurrence is the +application argv, full stop -- RUNTIME-MARKERS is not applied to it. A literal +application argument that happens to match a runtime marker (e.g. an app that +itself accepts \"--end-toplevel-options\") must never be reinterpreted as a +launcher token just because some earlier, unrelated launcher also uses that +marker. Only when SEPARATOR is absent (or not given) does RUNTIME-MARKERS +apply, dropping everything through the last matching marker." + (let* ((remaining (copy-list argv)) + (tail (and separator (member separator remaining :test #'string=)))) + (cond + (tail (rest tail)) + (runtime-markers (%drop-through-last-marker remaining runtime-markers)) + (t remaining)))) (defun application-argv (&key (argv (current-process-argv)) (runtime-markers (default-runtime-markers)) diff --git a/tests/cases-completion-bash.lisp b/tests/cases-completion-bash.lisp index 8764f86..799af07 100644 --- a/tests/cases-completion-bash.lisp +++ b/tests/cases-completion-bash.lisp @@ -72,4 +72,17 @@ (it "hides hidden commands and options" (let ((app (completion-hidden-commands-and-options-fixture))) (assert-completion-searches (app) "visible" "--visible-flag") - (assert-completion-not-searches (app) "secret" "--secret-flag")))) + (assert-completion-not-searches (app) "secret" "--secret-flag"))) + + (it "matches command-scoped attached-value candidates against the command-prefixed current word" + ;; The value_source case labels for a command option are rendered as + ;; "command:--option=*", so the case statement selecting on them must + ;; switch on "command:$cur", not the bare "$cur" -- otherwise the labels + ;; can never match and attached-value completion silently never fires. + (let ((app (make-completion-fixture + :command-options (list (make-option :name "output" + :short #\o + :kind :value + :choices '("bin" "obj")))))) + (assert-completion-searches (app) + "case \"compile:$cur\" in")))) diff --git a/tests/cases-completion-commands.lisp b/tests/cases-completion-commands.lisp index 05437c7..cef4bcc 100644 --- a/tests/cases-completion-commands.lisp +++ b/tests/cases-completion-commands.lisp @@ -72,4 +72,24 @@ (it "render-completion rejects unsupported shells" (signals cli-invalid-positional-value - (render-completion (make-app :name "demo") "pwsh")))) + (render-completion (make-app :name "demo") "pwsh"))) + + (it "renderers return the script as a string when no stream is given" + (let ((app (make-app :name "demo" + :global-options (list (make-option :name "verbose" :kind :flag)) + :commands (list (make-command :name "serve"))))) + ;; With no stream, each renderer returns exactly what the stream form + ;; writes, so the documented `(write-string (render-completion ...))` + ;; pattern works instead of returning no values. + (dolist (shell '("bash" "zsh" "fish")) + (let ((returned (render-completion app shell)) + (written (with-string-output (out) (render-completion app shell out)))) + (expect (stringp returned)) + (expect (plusp (length returned))) + (expect (string= returned written)))) + (expect (string= (render-bash-completion app) + (with-string-output (out) (render-bash-completion app out)))) + (expect (string= (render-zsh-completion app) + (with-string-output (out) (render-zsh-completion app out)))) + (expect (string= (render-fish-completion app) + (with-string-output (out) (render-fish-completion app out))))))) diff --git a/tests/cases-help.lisp b/tests/cases-help.lisp index 222df1f..1e314c2 100644 --- a/tests/cases-help.lisp +++ b/tests/cases-help.lisp @@ -32,6 +32,18 @@ (with-app-help-text (text app) (assert-searches text "Config file. (requires: --profile; conflicts: --token)")))) + (it "includes requires-any-of metadata" + (let ((app (make-app + :name "demo" + :global-options + (list (make-option :name "token" :kind :value) + (make-option :name "username" :kind :value) + (make-option :name "login" :kind :flag + :description "Sign in." + :requires-any-of '(:token :username)))))) + (with-app-help-text (text app) + (assert-searches text "Sign in. (requires one of: --token, --username)")))) + (it "hides hidden option relationship targets" (let ((app (make-app :name "demo" diff --git a/tests/cases-parse.lisp b/tests/cases-parse.lisp index dee31af..adb3377 100644 --- a/tests/cases-parse.lisp +++ b/tests/cases-parse.lisp @@ -221,6 +221,18 @@ :separator "--") '("--instrument" "USD_JPY"))))) + (it "does not reinterpret a marker-shaped application argument after the separator" + ;; Everything after the first separator is opaque application argv -- + ;; a literal token there that happens to match a runtime marker must not + ;; be treated as a launcher token and dropped along with what precedes it. + (let ((argv '("sbcl" "--script" "foo.lisp" + "--" "--end-toplevel-options" "positional-arg"))) + (expect (equal (extract-application-argv + :argv argv + :runtime-markers '("--end-toplevel-options") + :separator "--") + '("--end-toplevel-options" "positional-arg"))))) + (it "returns a fresh default runtime markers list" (let ((left (default-runtime-markers)) (right (default-runtime-markers))) @@ -273,4 +285,31 @@ (expect (equal (positional-value inv :rest) '("--bar" "baz")))) (with-parsed-argv (inv app '("f" "-x" "--bar" "baz")) (expect (option-value inv :exec)) - (expect (equal (positional-value inv :rest) '("--bar" "baz"))))))) + (expect (equal (positional-value inv :rest) '("--bar" "baz")))))) + + (it "preserves unconsumed short-cluster characters after a mid-cluster stop-parsing flag" + ;; A stop-parsing flag/boolean has no value of its own to absorb the rest + ;; of the cluster, unlike :VALUE/:OPTIONAL-VALUE options -- the remainder + ;; must resurface as literal input instead of being silently dropped. + (let ((app (make-app :name "f" + :global-options (list (make-option :name "exec" :short #\x + :kind :flag + :stop-parsing-p t) + (make-option :name "bar" :short #\b + :kind :flag)) + :positionals (list (make-positional :key :rest :rest-p t))))) + (with-parsed-argv (inv app '("f" "-xb" "baz")) + (expect (option-value inv :exec)) + (expect (null (option-value inv :bar))) + (expect (equal (positional-value inv :rest) '("-b" "baz")))))) + + (it "consumes a bare - as a separated optional value" + ;; A bare "-" is the stdin/stdout idiom, not an option token -- an + ;; optional-value option configured to consume a separated value must be + ;; able to take it, the same way it takes any other non-option token. + (let ((app (make-app :name "f" + :global-options (list (optional-value-option + "output" + :consume-optional-value-p t))))) + (with-parsed-argv (inv app '("f" "--output" "-")) + (expect (equal (option-value inv :output) "-")))))) diff --git a/tests/cases-validation-relations.lisp b/tests/cases-validation-relations.lisp index 57b6eb8..4de60a2 100644 --- a/tests/cases-validation-relations.lisp +++ b/tests/cases-validation-relations.lisp @@ -64,6 +64,75 @@ (expect (string= (option-value inv :profile) "dev")) (expect (string= (option-value inv :config) "dev.toml")))) + (it "requires at least one of the declared requires-any-of alternatives" + (let ((app (make-app :name "demo" + :global-options (list (make-option :name "token" :kind :value) + (make-option :name "username" :kind :value) + (make-option :name "password" :kind :value) + (make-option :name "login" :kind :flag + :requires-any-of '(:token :username)))))) + (with-parsed-argv (inv app '("demo" "--login" "--token" "abc")) + (expect (option-value inv :login))) + (with-parsed-argv (inv app '("demo" "--login" "--username" "bob" "--password" "x")) + (expect (option-value inv :login))) + (with-parsed-argv (inv app '("demo")) + (expect (null (option-value inv :login)))))) + + (it "signals when none of the requires-any-of alternatives are present" + (with-caught-signal-from-argv + ((cli-missing-any-of-options condition) + (app (make-app :name "demo" + :global-options (list (make-option :name "token" :kind :value) + (make-option :name "username" :kind :value) + (make-option :name "login" :kind :flag + :requires-any-of '(:token :username)))) + '("demo" "--login"))) + (:eq cli-missing-any-of-options-name :login) + (:equal cli-missing-any-of-options-alternatives '(:token :username)) + (:searches cli-error-message "Option --login requires one of: --token, --username."))) + + (it "requires-any-of hidden targets without leaking their names" + (with-caught-signal-from-argv + ((cli-missing-any-of-options condition) + (app (make-app :name "demo" + :global-options (list (make-option :name "internal-token" + :kind :value + :hidden-p t) + (make-option :name "login" :kind :flag + :requires-any-of '(:internal-token)))) + '("demo" "--login"))) + (:searches cli-error-message "Option --login requires one of: a hidden option.") + (:not-searches cli-error-message "--internal-token"))) + + (it "rejects unknown requires-any-of targets" + (signals-invalid-specification + (make-app :name "demo" + :global-options (list (make-option :name "login" :kind :flag + :requires-any-of '(:token)))))) + + (it "rejects requires-any-of self references" + (signals-invalid-specification + (make-app :name "demo" + :global-options (list (make-option :name "login" :kind :flag + :requires-any-of '(:login)))))) + + (it "rejects requires-any-of alternatives that all conflict with the option" + ;; If every alternative conflicts with the option itself, the option can + ;; never be validly supplied: alone it fails the any-of requirement, and + ;; together with an alternative it fails the conflict check. + (signals-invalid-specification + (make-app :name "demo" + :global-options (list (make-option :name "b" :kind :flag) + (make-option :name "a" :kind :flag + :requires-any-of '(:b) + :conflicts-with '(:b))))) + (signals-invalid-specification + (make-app :name "demo" + :global-options (exclusive-group + (make-option :name "a" :kind :flag + :requires-any-of '(:b)) + (make-option :name "b" :kind :flag))))) + (it "requires hidden target without leaking its name" (with-caught-signal-from-argv ((cli-missing-dependent-option condition) @@ -130,6 +199,31 @@ :kind :value :conflicts-with '("token")))))) + (it "keeps each app's cached relation rulebase independent when a command is reused across apps" + ;; COMMAND-SPEC is documented as a reusable, composable object -- the same + ;; instance can be spliced into :COMMANDS for more than one MAKE-APP call. + ;; A relation rulebase cached ON the shared command struct would let a + ;; later MAKE-APP call silently overwrite the rulebase an earlier, + ;; already-in-use app depends on. + (let* ((shared-command (make-command + :name "login" + :options (list (make-option :name "go" :kind :flag + :requires '(:token))))) + (app1 (make-app :name "app1" + :global-options (list (make-option :name "token" :kind :value)) + :commands (list shared-command)))) + (with-parsed-argv (inv app1 '("app1" "login" "--go" "--token" "abc")) + (expect (option-value inv :go))) + (make-app :name "app2" + :global-options (list (make-option :name "token" :kind :value + :requires '(:extra)) + (make-option :name "extra" :kind :value)) + :commands (list shared-command)) + ;; Re-parsing the same, previously-successful app1 invocation must still + ;; work -- app2's build must not have corrupted app1's cached rulebase. + (with-parsed-argv (inv app1 '("app1" "login" "--go" "--token" "abc")) + (expect (option-value inv :go))))) + (it "resolves alias targets" (with-parsed-argv (inv (make-app :name "demo" :global-options (list (make-option :name "profile" diff --git a/tests/cases-validation-specification.lisp b/tests/cases-validation-specification.lisp index c2b81c8..014b9a1 100644 --- a/tests/cases-validation-specification.lisp +++ b/tests/cases-validation-specification.lisp @@ -20,6 +20,34 @@ (signals-invalid-specification (make-app :name "demo" :global-options (list left right))))) + (it "rejects options whose keys collide despite distinct case-sensitive short names" + ;; OPTION-KEYWORD downcases its argument, so single-character names "-a" + ;; and "-A" (deliberately case-sensitive as CLI tokens) both resolve to + ;; the same :A key -- without this check the two specs would silently + ;; share one storage slot instead of being rejected as a spec error. + (let ((left (make-option :short #\a :kind :flag)) + (right (make-option :short #\A :kind :flag))) + (signals-invalid-specification + (make-app :name "demo" :global-options (list left right))))) + + (it "rejects a user option that reuses the reserved :help key" + ;; BUILT-IN-OPTION-P/BUILT-IN-OPTION-ACTION key off OPTION-KEY's value + ;; alone, so an ordinary option given :key :help would hijack dispatch + ;; into the help action regardless of its own :kind. + (signals-invalid-specification + (make-app :name "demo" + :global-options (list (make-option :key :help + :name "output" + :kind :value))))) + + (it "rejects a user option that reuses the reserved :version key" + (signals-invalid-specification + (make-app :name "demo" + :version "1.0.0" + :global-options (list (make-option :key :version + :name "output" + :kind :value))))) + (it "rejects duplicate command names" (let ((left (make-command :name "build")) (right (make-command :name "build"))) @@ -110,6 +138,23 @@ :positionals (list (make-positional :key :args :rest-p t) (make-positional :key :target :required-p t))))))) + (it "rejects a required root positional following an optional one" + ;; Positionals are assigned tokens greedily in declared order with no + ;; backtracking, so a required positional after an optional one could + ;; never receive a value even when one was supplied. + (signals-invalid-specification + (make-app :name "demo" + :positionals (list (make-positional :key :first) + (make-positional :key :second :required-p t))))) + + (it "rejects a required command positional following an optional one" + (signals-invalid-specification + (make-app :name "demo" + :commands (list (make-command + :name "run" + :positionals (list (make-positional :key :first) + (make-positional :key :second :required-p t))))))) + (it "rejects duplicate root positional keys" (signals-invalid-specification (make-app :name "demo"