From 6af0fd541e5ff5559805cf1f496560e76de186bc Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Mon, 13 Jul 2026 15:03:39 +1000 Subject: [PATCH] punk::args 0.12.0: formcheck on-demand multiform ambiguity analysis + @form -overlapallowed sanction (G-074 achieved) New punk::args::formcheck ?-return dict|summary?: reports the form pairs of a multiform definition that some argument list could cleanly match simultaneously (the multipleformmatches inputs). Static pairwise pass over the resolved FORMS enumerates each form's positional word-slot chains (leaders then values; -optional and ?-wrapped clause-member branching; -multiple capped; options excluded - order-free), screens aligned equal-length chains per position (discriminator words via choiceword_match, type witnesses from a small table), and CONFIRMS every candidate witness arglist with a real single-form parse against both forms (parse_status - no raise, no user-supplied words, no define/resolve cost). Findings are therefore witnessed - discriminated form pairs cannot false-alarm; misses (exotic types, option-requiring forms, enumeration caps) are the documented conservative direction. Classes: type_weakness (discriminator aligned with a permissive non-validating type - any/none/string/ansistring/globstring/expr/script) vs structural (forms genuinely share an argument shape). New @form key -overlapallowed sanctions a KNOWN overlap on either pair member: the finding reports with sanctioned 1 and leaves the result's unsanctioned list (the actionable/gate subset). Parse behaviour is never affected; unknown form names are rejected at definition resolve (end-of-forms cycle). @form directive doc updated. tclcore moduledoc 0.3.4: the documented after cancelid/cancelscript overlap (runtime-liveness ambiguity, 0.3.0 record) sanctioned on the cancelid form - ::after now reports zero unsanctioned findings while 'after cancel ' still raises multipleformmatches. ::lseq deliberately unsanctioned: formcheck reports range/start_count (witness {1 count 1}) AND range/count (witness {1 by 1}) - both real, both rooted in the expr-typed end slot, kept visible pending an expr syntax-validating type (G-069/G-070). Tests: new args/formcheck.test (7) - no-finding cases (parse withid/withdef pair, afterish/sharedform fixtures), class+sanction fixture, unknown-form rejection, -return summary, ::lseq/::after pins with witnesses re-verified, sanction parse-neutrality. punk::args suite 210/210, punk::ns 57/57. G-074 achieved and archived (acceptance review in the detail file); G-055 verification gate gains the formcheck step (unsanctioned must be empty for regenerated multiform commands). Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- CHANGELOG.md | 4 + GOALS-archive.md | 4 + GOALS.md | 4 - goals/G-055-tclcore-regen-workflow.md | 16 +- ...G-074-punkargs-multiform-ambiguity-lint.md | 72 ++- punkproject.toml | 2 +- src/modules/punk/args-999999.0a1.0.tm | 476 ++++++++++++++++++ src/modules/punk/args-buildversion.txt | 3 +- .../args/moduledoc/tclcore-999999.0a1.0.tm | 6 +- .../args/moduledoc/tclcore-buildversion.txt | 3 +- .../punk/args/testsuites/args/formcheck.test | 195 +++++++ 11 files changed, 774 insertions(+), 11 deletions(-) rename goals/{ => archive}/G-074-punkargs-multiform-ambiguity-lint.md (64%) create mode 100644 src/tests/modules/punk/args/testsuites/args/formcheck.test diff --git a/CHANGELOG.md b/CHANGELOG.md index 1d87a40b..26668bfc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,10 @@ The latest `## [X.Y.Z]` header must match the `version` field in `punkproject.to Entries are newest-first; one bullet per notable change. See the root `AGENTS.md` "Project Versioning" section for the bump policy. +## [0.12.22] - 2026-07-13 + +- G-074 (achieved): punk::args 0.12.0 adds punk::args::formcheck - on-demand multiform ambiguity analysis. It reports the form pairs of a definition that some argument list could cleanly match simultaneously, confirming every candidate with a real parse of a synthetic witness arglist against both forms - so fully discriminated form pairs can never false-alarm, and each reported witness is a genuine multipleformmatches input. Findings classify as type-weakness (a literal/choice discriminator aligned with a permissive non-validating type such as expr/any/string - the 'lseq 1 count 5' class) vs structural (the forms genuinely share an argument shape - the 'after cancel id|script' class). The new @form -overlapallowed key sanctions a known/documented overlap for formcheck reporting only (parse behaviour untouched; unknown form names rejected at definition resolve); tclcore moduledoc 0.3.4 adopts it for the after cancel pair, leaving ::after with zero unsanctioned findings while ::lseq's expr-typed-end findings stay visible as actionable. New testsuite args/formcheck.test. + ## [0.12.21] - 2026-07-13 - G-076 (new goal, active): 'help tcl' now warns about the tcl9 dead-console defect (upstream ticket f10d91c2d3, root-caused in G-039: a dead console is never delivered to the script as a fileevent while the core's console reader thread busy-loops) via punk::lib 0.4.3's has_tclbug_console_deadspin — version-based detection through the pure classifier tclbug_console_deadspin_applies, gated by check::tclbug_console_deadspin_fixed_in (empty until a released Tcl contains the upstream fix verified by re-running the G-039 kill procedure). punk::repl 0.5.1 arms the dead-console watchdog only when that same check reports the runtime affected, so recording the fixed release once silences the warning and stops arming the watchdog together. Buginfo dicts gain a mitigated/mitigation axis orthogonal to level (punk 0.2.6 renders it): the deadspin warning keeps severity major but displays "(mitigated)" in subdued grey with the watchdog's scope described when punk::repl >= 0.5.0 is available to the runtime; non-repl console reads remain exposed and unmitigated warnings render unchanged. diff --git a/GOALS-archive.md b/GOALS-archive.md index 9b1af36d..5553bcd4 100644 --- a/GOALS-archive.md +++ b/GOALS-archive.md @@ -84,3 +84,7 @@ Acceptance: LICENSE.txt exists at the repo root containing the standard BSD-2-Cl ### G-071 [achieved 2026-07-12] punk::args value-allocation correctness for optional elements (lseq-class arglists) + parse_status -form → detail: goals/archive/G-071-punkargs-optional-allocation.md Scope: src/modules/punk/args-999999.0a1.0.tm (get_dict value allocation, private::get_dict_can_assign_value, parse_status), src/tests/modules/punk/args/testsuites/args/ (new allocation characterization suite), src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm (::lseq as the proving consumer) Acceptance: a new allocation characterization suite drives the lseq range matrix under explicit -form range - '0 10', '0 10 2', '0 10 by 2', '0 to 10 2', '0 .. 10 by 2', '1 5 by 0' parse per the lseq.n grammar (the three currently-failing cases fixed) and '0 10 2 4' still fails - plus reduced fixtures isolating the shape (optional choice value between required values + trailing optional-member clause) independent of the moduledoc; the ::if noise-word cases (mid-clause ?literal(then)?, clause-leading ?literal(else)?) keep passing - no regression to optional clause members generally; a genuinely invalid arglist's error names the failing element (the '..|to' misblame case pinned fixed); punk::args::parse_status accepts -form (single form name/index at minimum, consistent with parse) with its status structure reporting the form used; full punk::args and punk::ns suites pass with no expectations weakened; before/after results for the probe matrix recorded in this file. + +### G-074 [achieved 2026-07-13] punk::args multiform ambiguity analysis: on-demand form-overlap detection with sanctioned-overlap annotation → detail: goals/archive/G-074-punkargs-multiform-ambiguity-lint.md +Scope: src/modules/punk/args-999999.0a1.0.tm (analysis command, @form sanction key as decided in the work), src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm (::after/::lseq as proving consumers, sanction adoption), src/tests/modules/punk/args/testsuites/args/ (new suite) +Acceptance: the analysis command reports the two known real cases from the G-041 closeout - ::lseq range/start_count overlap via the expr-typed end slot (unsanctioned finding: type-weakness class) and ::after cancelid/cancelscript (documented-overlap class) - and reports nothing for multiform definitions whose forms are fully discriminated (the parse withid/withdef pair, the forms.test afterish fixture); classifications distinguish at minimum type-weakness overlap (a discriminator aligned with a permissive type) from structural overlap (no discriminating slot exists); the sanction annotation silences (or downgrades to acknowledged) a listed form pair without affecting parse behaviour, is rejected at definition resolve when it names unknown forms, and is adopted for the after cancel pair in the tclcore moduledoc; the analysis is conservative in the documented direction (may miss deep ambiguities, must not false-alarm on discriminated forms - the miss/report boundary is documented with the slot model); running it performs no parse of user-supplied words and adds no work to define/resolve for definitions that never call it; a new testsuite covers the finding classes, the sanction, the unknown-form rejection and the no-finding cases; full punk::args suite passes. diff --git a/GOALS.md b/GOALS.md index 238d7f94..7c5ad0f4 100644 --- a/GOALS.md +++ b/GOALS.md @@ -286,10 +286,6 @@ Detail: goals/G-072-punkargs-compound-clause-types.md Scope: src/modules/punk/args-999999.0a1.0.tm (spec key, choiceword_match pool, choices rendering in arg_error table+string renderers, validation message), src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm ('string is' forward-class adoption + per-class virtual id), src/tests/modules/punk/args/testsuites/args/ (new suite + tclcoreparity.test exemption) Detail: goals/G-073-punkargs-unavailable-choices.md -### G-074 [proposed] punk::args multiform ambiguity analysis: on-demand form-overlap detection with sanctioned-overlap annotation -Scope: src/modules/punk/args-999999.0a1.0.tm (analysis command, @form sanction key as decided in the work), src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm (::after/::lseq as proving consumers, sanction adoption), src/tests/modules/punk/args/testsuites/args/ (new suite) -Detail: goals/G-074-punkargs-multiform-ambiguity-lint.md - ### G-075 [proposed] punk::args (package) ids: working lookup and a user-facing package documentation surface Scope: src/modules/punk/args-999999.0a1.0.tm (id lookup/update_definitions prefix handling, usage/arg_error rendering of package-level ids), src/modules/punk/ns-999999.0a1.0.tm (cmdhelp/help-system surface), src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/modules/template_module-0.0.4.tm (template block as touched/verified), src/tests/modules/punk/args/testsuites/args/ + src/tests/modules/punk/ns/testsuites/ns/ (new coverage) Detail: goals/G-075-punkargs-package-ids.md diff --git a/goals/G-055-tclcore-regen-workflow.md b/goals/G-055-tclcore-regen-workflow.md index f17a3e85..5cfb617b 100644 --- a/goals/G-055-tclcore-regen-workflow.md +++ b/goals/G-055-tclcore-regen-workflow.md @@ -60,6 +60,16 @@ Per command: flag-lookalike shapes) run against the real command and parse_status, asserting error-vs-ok agreement; committed as a parity test deriving expectations from the live interpreter, not version arithmetic. + Additionally (G-074 achieved 2026-07-13 - + goals/archive/G-074-punkargs-multiform-ambiguity-lint.md): run + punk::args::formcheck on every + regenerated MULTIFORM command - new UNSANCTIONED findings block acceptance + (a type_weakness finding means a discriminator faces a permissive type and the + forms need tightening or the ambiguity is real; a genuine documented overlap is + sanctioned with @form -overlapallowed, as adopted for ::after cancel). The + result dict's 'unsanctioned' key is the gate value (must be empty). Known + pre-existing exception: ::lseq's range/start_count and range/count findings + stay unsanctioned pending an expr syntax-validating type (G-069/G-070). 4. Record provenance: the source checkin id the text was read from, noted with the definition (comment) and in the module changelog. @@ -146,8 +156,10 @@ other commands including the multi-form ::after. after#12' remains ambiguous in the model because a script can also be after#-shaped - real Tcl resolves by id LIVENESS at runtime (tries id first, falls back to script match), which no static type expresses; the - G-074 sanction then covers exactly that id-shaped witness rather than the - whole form pair. APPLIED 2026-07-13 (tclcore moduledoc 0.3.0, user-directed): + G-074 sanction (shipped 2026-07-13 as @form -overlapallowed, adopted on the + cancelid form in tclcore 0.3.4) acknowledges the cancelid/cancelscript pair + for formcheck reporting - thanks to the id typing, the only witnesses the + pair still shares ARE the id-shaped words. APPLIED 2026-07-13 (tclcore moduledoc 0.3.0, user-directed): both ids typed stringstartswith() via a build-time %AFTERIDPREFIX% string map. CORRECTED note for the workflow (the first record of this wrinkle misattributed it): parse-field tstr ${...} IS diff --git a/goals/G-074-punkargs-multiform-ambiguity-lint.md b/goals/archive/G-074-punkargs-multiform-ambiguity-lint.md similarity index 64% rename from goals/G-074-punkargs-multiform-ambiguity-lint.md rename to goals/archive/G-074-punkargs-multiform-ambiguity-lint.md index c831eb40..b54d27b1 100644 --- a/goals/G-074-punkargs-multiform-ambiguity-lint.md +++ b/goals/archive/G-074-punkargs-multiform-ambiguity-lint.md @@ -1,6 +1,6 @@ # G-074 punk::args multiform ambiguity analysis: on-demand form-overlap detection with sanctioned-overlap annotation -Status: proposed +Status: achieved 2026-07-13 Scope: src/modules/punk/args-999999.0a1.0.tm (analysis command, @form sanction key as decided in the work), src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm (::after/::lseq as proving consumers, sanction adoption), src/tests/modules/punk/args/testsuites/args/ (new suite) Goal: an on-demand analysis command (candidate spelling punk::args::formcheck ) reports, for a multiform definition, the form pairs an argument list could cleanly match simultaneously - a conservative static pass over the forms' leading slots and arity windows that flags discriminator-vs-permissive-type alignments (the 'lseq 1 count 5' class, where a literal/choice discriminator in one form aligns with a non-validating type like expr/any/string in another) and discriminator-free overlaps (the 'after cancel id|script' class) - with a definition-level annotation (spelling decided in the work, e.g @form key) that sanctions known/documented overlaps so they report as acknowledged rather than as findings, keeping the unsanctioned report actionable; the define hot path is untouched (analysis runs only on demand - interactive, test-time, and as a G-055 verification-gate step for regenerated multiform commands). Acceptance: the analysis command reports the two known real cases from the G-041 closeout - ::lseq range/start_count overlap via the expr-typed end slot (unsanctioned finding: type-weakness class) and ::after cancelid/cancelscript (documented-overlap class) - and reports nothing for multiform definitions whose forms are fully discriminated (the parse withid/withdef pair, the forms.test afterish fixture); classifications distinguish at minimum type-weakness overlap (a discriminator aligned with a permissive type) from structural overlap (no discriminating slot exists); the sanction annotation silences (or downgrades to acknowledged) a listed form pair without affecting parse behaviour, is rejected at definition resolve when it names unknown forms, and is adopted for the after cancel pair in the tclcore moduledoc; the analysis is conservative in the documented direction (may miss deep ambiguities, must not false-alarm on discriminated forms - the miss/report boundary is documented with the slot model); running it performs no parse of user-supplied words and adds no work to define/resolve for definitions that never call it; a new testsuite covers the finding classes, the sanction, the unknown-form rejection and the no-finding cases; full punk::args suite passes. @@ -84,3 +84,73 @@ string, none-validating) and pairs with no discriminating slot at all. - The 'after cancel' sanction is also the display question's anchor: a sanctioned overlap is why the G-041 doc surface marks BOTH forms and shows the ambiguity message - the sanction must not suppress that runtime honesty. + +## Progress + +2026-07-13 (agent): implemented whole in punk::args 0.12.0 + tclcore moduledoc 0.3.4. + +Command spelling: punk::args::formcheck ?-return dict|summary? (default dict; +the dict carries the summary text as a key, so one return shape serves both the +G-055 gate and interactive use). Sanction spelling: @form -overlapallowed + on either pair member (stored in the FORMS dict by the +existing @form key-merge - no record-parsing change); unknown form names rejected +in resolve's end-of-forms cycle (all forms exist by then). + +Design refinement over the drafted pure-static pass, adopted during implementation: +the static analysis PROPOSES, a real parse CONFIRMS. The pairwise pass enumerates +each form's positional word-slot chains (private::formcheck_chains - leaders then +values, branching on -optional args and ?-wrapped clause members, -multiple capped +at 2 repetitions), screens aligned equal-length chains per position +(formcheck_slotinfo/formcheck_slot_accepts - discriminator words via +choiceword_match exactly as drafted, type witnesses from a small table, unknown +types optimistically 'maybe'), and then parses each candidate witness arglist +against both forms individually (parse_status -form - no raise, no +user-supplied words). Only a witness that parses cleanly against BOTH forms is +reported, which upgrades the no-false-alarm requirement from 'conservative +heuristic' to 'true by construction' - and the confirmed witness is exactly the +report's example arglist. The miss/report boundary (documented in the formcheck +help): witness derivation can fail for types without a derivable word, forms +requiring options (options excluded from the positional model as drafted), and +enumeration caps. + +Findings on the motivating models: +- ::lseq: range/start_count type_weakness, witness {1 count 1} (range's + number|expr end slot swallows the literalprefix(count) word) - PLUS a second + real finding the static draft didn't predict: range/count type_weakness, + witness {1 by 1} (same expr-typed end slot swallows count-form's 'by' + discriminator). Both genuinely raise multipleformmatches; both left + unsanctioned (actionable - resolved when an expr syntax-validating type + arrives, G-069/G-070). +- ::after: exactly one finding, cancelid/cancelscript structural, witness + {cancel after#}; sanctioned via -overlapallowed on the cancelid @form line + (tclcore 0.3.4) leaving zero unsanctioned findings. Parse honesty pinned: + multipleformmatches still raises for id-shaped cancel words. +- No findings: ::punk::args::parse (withid/withdef literals), the afterish + fixture (int vs literal leading slots), the sharedform fixture (arity windows). + +Tests: new args/formcheck.test (7 tests) - no-finding cases, class + sanction on a +local fixture, unknown-form resolve rejection, -return summary, ::lseq/::after +pins (witnesses re-verified against both forms inside the test), sanction +parse-neutrality. Full punk::args suite 210 passed / 0 failed; punk::ns suite +57/57. + +Acceptance review: two known G-041 cases reported with the required classes - +yes (::lseq range/start_count type-weakness unsanctioned; ::after +cancelid/cancelscript documented-overlap sanctioned). Nothing reported for +discriminated multiform definitions - yes (parse pair + fixtures pinned). +Classifications distinguish type-weakness from structural - yes (relation +recorded per witness slot). Sanction downgrades to acknowledged without parse +effect, rejects unknown forms at resolve, adopted for after cancel - yes (all +pinned). Conservative in the documented direction - yes, strengthened: findings +are witness-confirmed so false alarms are impossible by construction; misses +documented with the slot model in the command help. No parse of user-supplied +words (witnesses are synthetic), no define/resolve cost for definitions that +never call it (only the O(list) -overlapallowed name check when the key is +present) - yes. New testsuite covering finding classes/sanction/rejection/ +no-finding - yes. Full suite passes - yes. + +Deferred (recorded, not blocking): G-055's workflow doc gains the formcheck gate +step when G-055 activates (noted in its detail file); punk::ns::cmdhelp does not +yet surface sanctioned-overlap acknowledgement in rendered help (the G-041 +both-forms marking already shows the ambiguity - display-side integration can +ride a future doc-surface goal). diff --git a/punkproject.toml b/punkproject.toml index e5a0d710..e666b2da 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,4 +1,4 @@ [project] name = "punkshell" -version = "0.12.21" +version = "0.12.22" license = "BSD-2-Clause" diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 2d0a217d..ec946822 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -820,8 +820,17 @@ tcl::namespace::eval punk::args { %B%@form%N% ?opt val...? (used for commands with multiple forms) directive-options: -form -synopsis + -overlapallowed The -synopsis value allows overriding the auto-calculated synopsis. + The -overlapallowed value names other forms this form is + KNOWN to overlap with (an argument list can cleanly match + both - e.g 'after cancel ' where real Tcl + disambiguates by runtime state). It sanctions the overlap + for punk::args::formcheck reporting only - parse behaviour + is unaffected (an ambiguous argument list still raises + multipleformmatches). Unknown form names are rejected when + the definition is resolved. %B%@formdisplay%N% ?opt val...? directive-options: -header (text for header row of table) -body (override autogenerated arg info for form) @@ -3606,6 +3615,19 @@ tcl::namespace::eval punk::args { dict for {fid FDICT} $F { dict set F $fid {} ;#detach + #G-074: @form -overlapallowed sanctions a known form overlap for + #punk::args::formcheck reporting - it must name forms that exist in this + #definition. Validated here because all forms have been created by now. + #(the current form's key still exists in F while detached - self-reference + #is pointless but harmless and not rejected) + if {[dict exists $FDICT -overlapallowed]} { + foreach oaform [dict get $FDICT -overlapallowed] { + if {![dict exists $F $oaform]} { + error "punk::args::resolve - @form -overlapallowed for form '$fid' names unknown form '$oaform' (known forms: [dict keys $F]) @id:$DEF_definition_id" + } + } + } + #set mashargs [dict get $F $fid OPT_MASHES] set mashargs [dict get $FDICT OPT_MASHES] if {[llength $mashargs]} { @@ -6979,6 +7001,460 @@ tcl::namespace::eval punk::args { return $ranked } + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + #G-074 punk::args::formcheck - on-demand multiform ambiguity analysis. + #Static pairwise pass over a definition's resolved FORMS: enumerate the positional + #word-slot chains each form can present, derive candidate witness arglists for + #aligned chains of equal length, and CONFIRM each candidate by parsing the witness + #against both forms (parse_status - no error raise, no user-supplied words). + #Only a witnessed overlap is reported, so fully discriminated form pairs cannot + #false-alarm; the documented miss direction is witness derivation - exotic types + #without a derivable witness word, required options (options are excluded from the + #positional model), and enumeration caps (-multiple repetitions, chain counts). + #Nothing here runs at define/resolve time apart from the cheap -overlapallowed + #known-form validation. + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + + #enumerate the positional word-slot chains a form can present - leaders then values, + #branching on -optional arguments and ?-wrapped optional clause members, with + #-multiple arguments capped at multiple_cap repetitions (same member pattern per + #repetition). Each chain is a list of slots {arg type } - one + #slot per word position. @leaders/@values min/max windows are not re-checked here: + #every candidate overlap is confirmed by a real parse before being reported. + proc private::formcheck_chains {formdict {multiple_cap 2} {chain_cap 400}} { + set ARG_INFO [dict get $formdict ARG_INFO] + set chains [list {}] + foreach argname [list {*}[dict get $formdict LEADER_NAMES] {*}[dict get $formdict VAL_NAMES]] { + set typelist [dict get $ARG_INFO $argname -type] + #member patterns for a single occurrence of this argument + set patterns [list {}] + foreach tp $typelist { + if {[string match {\?*\?} $tp]} { + set inclusions [list "" [string trim $tp ?]] + } else { + set inclusions [list $tp] + } + set withmember [list] + foreach p $patterns { + foreach inc $inclusions { + if {$inc eq ""} { + lappend withmember $p + } else { + lappend withmember [list {*}$p $inc] + } + } + } + set patterns $withmember + } + #an occurrence consumes at least one word + set occurrence_patterns [lsearch -all -inline -not -exact $patterns {}] + if {![llength $occurrence_patterns]} { + continue + } + if {[dict get $ARG_INFO $argname -multiple]} { + set max_occurrences $multiple_cap + } else { + set max_occurrences 1 + } + if {[dict get $ARG_INFO $argname -optional]} { + set min_occurrences 0 + } else { + set min_occurrences 1 + } + set newchains [list] + foreach chain $chains { + for {set occ $min_occurrences} {$occ <= $max_occurrences} {incr occ} { + if {$occ == 0} { + lappend newchains $chain + continue + } + foreach pat $occurrence_patterns { + set extended $chain + for {set r 0} {$r < $occ} {incr r} { + foreach membertype $pat { + lappend extended [dict create arg $argname type $membertype] + } + } + lappend newchains $extended + } + } + } + set chains $newchains + if {[llength $chains] > $chain_cap} { + #conservative truncation (documented miss direction) + set chains [lrange $chains 0 $chain_cap-1] + } + } + return $chains + } + + #static description of one positional slot for overlap screening: + # disc 1 if the slot is a discriminator (literal/literalprefix alternates + # or a restricted choice set - the same notion as form_literal_affinity) + # discwords the discriminator's words (choice words, literal values) + # permissive 1 if any type alternate performs no word validation (any/none/string/ + # ansistring/globstring/expr/script) - the 'type-weakness' side + # witnesses candidate words derivable from the types (a word satisfying the type) + proc private::formcheck_slotinfo {formdict slot} { + set ARG_INFO [dict get $formdict ARG_INFO] + set argname [dict get $slot arg] + set tp [string trim [dict get $slot type] ?] + set disc 0 + set discwords [list] + set permissive 0 + set witnesses [list] + if {[dict exists $ARG_INFO $argname -choices] || [dict exists $ARG_INFO $argname -choicegroups]} { + set choicewords [list] + if {[dict exists $ARG_INFO $argname -choices]} { + lappend choicewords {*}[dict get $ARG_INFO $argname -choices] + } + if {[dict exists $ARG_INFO $argname -choicegroups]} { + dict for {_grp grpmembers} [dict get $ARG_INFO $argname -choicegroups] { + lappend choicewords {*}$grpmembers + } + } + if {[Dict_getdef $ARG_INFO $argname -choicerestricted 1]} { + set disc 1 + lappend discwords {*}$choicewords + } else { + #unrestricted choices don't discriminate but their words satisfy validation + lappend witnesses {*}$choicewords + } + } + foreach alt [split_type_expression $tp] { + if {[llength $alt] == 2} { + lassign $alt t param + switch -exact -- $t { + literal - literalprefix { + set disc 1 + lappend discwords $param + } + stringstartswith - stringendswith - stringcontains { + lappend witnesses $param + } + default {} + } + } else { + switch -exact -- $alt { + any - none - string - ansistring - globstring - expr - script - "" { + set permissive 1 + } + int - integer - number - bool - boolean { + lappend witnesses 1 + } + double { + lappend witnesses 1.5 + } + list { + lappend witnesses x + } + dict { + lappend witnesses {k v} + } + default {} + } + } + } + if {$permissive} { + lappend witnesses x + } + return [dict create disc $disc discwords $discwords permissive $permissive witnesses $witnesses] + } + + #static acceptance screen of a word against a slot - returns yes|no|maybe. + #Restricted choice sets are screened via choiceword_match (the shared G-040 + #resolver) so screening cannot diverge from parse acceptance; type alternates the + #screen doesn't model return maybe - the confirming parse decides. This screen only + #prunes candidate witnesses: a wrongly optimistic maybe costs a parse attempt, it + #cannot produce a false finding. + proc private::formcheck_slot_accepts {formdict slot word} { + set ARG_INFO [dict get $formdict ARG_INFO] + set argname [dict get $slot arg] + set tp [string trim [dict get $slot type] ?] + if {([dict exists $ARG_INFO $argname -choices] || [dict exists $ARG_INFO $argname -choicegroups]) + && [Dict_getdef $ARG_INFO $argname -choicerestricted 1]} { + #a restricted choice set rejects non-choice words regardless of type + set cw_allchoices [list] + if {[dict exists $ARG_INFO $argname -choices]} { + lappend cw_allchoices {*}[dict get $ARG_INFO $argname -choices] + } + if {[dict exists $ARG_INFO $argname -choicegroups]} { + dict for {_grp grpmembers} [dict get $ARG_INFO $argname -choicegroups] { + lappend cw_allchoices {*}$grpmembers + } + } + set cwm [choiceword_match $word\ + [Dict_getdef $ARG_INFO $argname -nocase 0]\ + $cw_allchoices\ + [Dict_getdef $ARG_INFO $argname -choicealiases {}]\ + [Dict_getdef $ARG_INFO $argname -choiceprefix 1]\ + [Dict_getdef $ARG_INFO $argname -choiceprefixdenylist {}]\ + [Dict_getdef $ARG_INFO $argname -choiceprefixreservelist {}]\ + ] + return [expr {[dict get $cwm matched] ? "yes" : "no"}] + } + set has_maybe 0 + foreach alt [split_type_expression $tp] { + if {[llength $alt] == 2} { + lassign $alt t param + switch -exact -- $t { + literal { + if {$word eq $param} {return yes} + } + literalprefix { + if {$word ne "" && [string equal -length [string length $word] $word $param]} {return yes} + } + stringstartswith { + if {[string range $word 0 [string length $param]-1] eq $param} {return yes} + } + stringendswith { + set param_last [expr {[string length $param]-1}] + if {$param eq "" || [string range $word end-$param_last end] eq $param} {return yes} + } + stringcontains { + if {[string first $param $word] >= 0} {return yes} + } + default { + set has_maybe 1 + } + } + } else { + switch -exact -- $alt { + any - none - string - ansistring - globstring - expr - script - "" { + return yes + } + int - integer { + if {[string is integer -strict $word]} {return yes} + } + number - double { + if {[string is double -strict $word]} {return yes} + } + bool - boolean { + if {[string is boolean -strict $word]} {return yes} + } + list { + if {![catch {llength $word}]} {return yes} + } + dict { + if {![catch {dict size $word}]} {return yes} + } + default { + set has_maybe 1 + } + } + } + } + return [expr {$has_maybe ? "maybe" : "no"}] + } + + #overlap check of one form pair. For each pair of equal-length slot chains, derive + #per-position candidate witness words (discriminator words and type witnesses from + #both slots, screened by formcheck_slot_accepts) and confirm candidates with a real + #single-form parse of the witness against BOTH forms. Returns a finding dict + #(forms/class/length/witness/slots) for the first confirmed witness, or {} if no + #candidate was confirmed within the parse budget. + #class: type_weakness if some witness position aligns a discriminator with a + #permissive (non-validating) type on the other side; structural otherwise (the + #forms genuinely share an argument shape - 'after cancel id|script' class). + proc private::formcheck_pair {id spec fa fb {parse_budget 32}} { + set fda [dict get $spec FORMS $fa] + set fdb [dict get $spec FORMS $fb] + set chains_b_bylen [dict create] + foreach cb [formcheck_chains $fdb] { + dict lappend chains_b_bylen [llength $cb] $cb + } + set parses 0 + foreach ca [formcheck_chains $fda] { + set L [llength $ca] + if {$L == 0 || ![dict exists $chains_b_bylen $L]} {continue} + foreach cb [dict get $chains_b_bylen $L] { + #per-position candidate words + relation classification + set positions [list] + set viable 1 + for {set i 0} {$i < $L} {incr i} { + set slota [lindex $ca $i] + set slotb [lindex $cb $i] + set ia [formcheck_slotinfo $fda $slota] + set ib [formcheck_slotinfo $fdb $slotb] + set candidates [list] ;#{word score} - score 2: both sides screened yes + foreach w [list {*}[dict get $ia discwords] {*}[dict get $ib discwords]\ + {*}[dict get $ia witnesses] {*}[dict get $ib witnesses]] { + if {[lsearch -exact -index 0 $candidates $w] >= 0} {continue} + set acc_a [formcheck_slot_accepts $fda $slota $w] + set acc_b [formcheck_slot_accepts $fdb $slotb $w] + if {$acc_a eq "no" || $acc_b eq "no"} {continue} + lappend candidates [list $w [expr {($acc_a eq "yes") + ($acc_b eq "yes")}]] + } + if {![llength $candidates]} { + set viable 0 + break + } + set candidates [lrange [lsort -integer -decreasing -index 1 $candidates] 0 2] + if {[dict get $ia disc] && ![dict get $ib disc] && [dict get $ib permissive]} { + set relation discriminator_vs_permissive + } elseif {[dict get $ib disc] && ![dict get $ia disc] && [dict get $ia permissive]} { + set relation discriminator_vs_permissive + } elseif {[dict get $ia disc] && [dict get $ib disc]} { + set relation shared_discriminator + } else { + set relation co_satisfiable_types + } + lappend positions [list [lmap c $candidates {lindex $c 0}] $relation\ + [dict get $slota arg] [dict get $slotb arg]] + } + if {!$viable} {continue} + #witness combinations: best candidate per position, then vary one + #position at a time through its alternates + set base [lmap p $positions {lindex $p 0 0}] + set trylist [list $base] + for {set i 0} {$i < $L} {incr i} { + foreach altword [lrange [lindex $positions $i 0] 1 end] { + set varied $base + lset varied $i $altword + lappend trylist $varied + } + } + foreach witness $trylist { + if {$parses >= $parse_budget} {break} + incr parses 2 + if {![dict get [parse_status $witness -form [list $fa] withid $id] ok]} {continue} + if {![dict get [parse_status $witness -form [list $fb] withid $id] ok]} {continue} + #confirmed overlap - classify and report + set class structural + set slotreport [list] + for {set i 0} {$i < $L} {incr i} { + lassign [lindex $positions $i] _cands relation arga argb + if {$relation eq "discriminator_vs_permissive"} { + set class type_weakness + } + lappend slotreport [dict create word [lindex $witness $i]\ + args [list $arga $argb] relation $relation] + } + return [dict create forms [list $fa $fb] class $class length $L\ + witness $witness slots $slotreport] + } + if {$parses >= $parse_budget} {break} + } + if {$parses >= $parse_budget} {break} + } + return {} + } + + lappend PUNKARGS [list { + @id -id ::punk::args::formcheck + @cmd -name punk::args::formcheck\ + -summary\ + "Analyse a multiform definition for form pairs an argument list could match simultaneously."\ + -help\ + "Analyse the definition identified by id for AMBIGUOUS form pairs: pairs + of @form forms for which some argument list cleanly matches both, so a + parse without -form would raise a multipleformmatches error. + + The analysis is static-first: it aligns the positional argument slots of + each form pair (leaders then values - options are order-free and excluded + from the positional model), derives candidate 'witness' argument lists, + and only reports a pair after CONFIRMING a witness by parsing it against + both forms individually. A reported overlap is therefore always real - + fully discriminated form pairs cannot be false-alarmed - while the miss + direction is conservative: overlaps whose witness the analysis cannot + derive (exotic validation types, forms requiring options, deep -multiple + repetition) may go unreported. No user-supplied argument words are + parsed, and definitions that never call formcheck pay no cost at + define/resolve time. + + Finding classes: + type_weakness a discriminator slot (literal()/literalprefix() + alternates or a restricted choice set) in one form + aligns with a permissive type that performs no word + validation (any/none/string/ansistring/globstring/ + expr/script) in the other - the permissive type + swallows the discriminator word (e.g 'lseq 1 count 5': + range's end slot typed number|expr accepts the word + 'count'). Usually fixable by tightening the type. + structural the forms genuinely share an argument shape with no + discriminating slot difference (e.g 'after cancel x' + where x is id-shaped - real Tcl disambiguates by + runtime state). If intended, sanction the pair with + @form -overlapallowed so it reports as acknowledged. + + A pair sanctioned via @form -overlapallowed (on either + member) is still reported, with sanctioned 1 - the sanction documents + intent for this analysis only and never changes parse behaviour. + + Returns a dict: + id the analysed definition id + form_names declared forms in declaration order + pairs every form pair analysed (list of 2-element lists) + findings dict keyed by pair {formA formB} - each finding has + forms, class, length, witness (a confirmed argument + list matching both forms), slots (per-position word, + argument names and slot relation) and sanctioned (0|1) + unsanctioned pair keys of findings not covered by -overlapallowed + (the actionable subset - e.g a verification gate can + require this to be empty) + summary human-readable report of the above + With -return summary only the summary text is returned." + -return -type string -default dict -choices {dict summary} -help\ + "dict: full machine-parsable analysis (includes the summary as a key). + summary: the human-readable report text only." + @values -min 1 -max 1 + id -type string -help\ + "id of a punk::args definition (as accepted by punk::args::get_spec)" + }] + proc formcheck {args} { + set argd [punk::args::parse $args withid ::punk::args::formcheck] + lassign [dict values $argd] leaders opts values received + set id [dict get $values id] + set opt_return [dict get $opts -return] + + set spec [get_spec $id] + if {$spec eq ""} { + error "punk::args::formcheck - no such id: '$id'" + } + set form_names [dict get $spec form_names] + set pairs [list] + set findings [dict create] + set unsanctioned [list] + for {set i 0} {$i < [llength $form_names]} {incr i} { + for {set j [expr {$i+1}]} {$j < [llength $form_names]} {incr j} { + set fa [lindex $form_names $i] + set fb [lindex $form_names $j] + lappend pairs [list $fa $fb] + set finding [private::formcheck_pair $id $spec $fa $fb] + if {$finding eq ""} {continue} + set sanctioned 0 + if {$fb in [Dict_getdef $spec FORMS $fa -overlapallowed {}] + || $fa in [Dict_getdef $spec FORMS $fb -overlapallowed {}]} { + set sanctioned 1 + } + dict set finding sanctioned $sanctioned + dict set findings [list $fa $fb] $finding + if {!$sanctioned} { + lappend unsanctioned [list $fa $fb] + } + } + } + set summarylines [list] + lappend summarylines "punk::args::formcheck $id: [llength $form_names] form(s), [llength $pairs] pair(s) analysed, [dict size $findings] overlap(s) ([llength $unsanctioned] unsanctioned)" + dict for {pairkey finding} $findings { + lassign $pairkey fa fb + set tag [expr {[dict get $finding sanctioned] ? "sanctioned" : "UNSANCTIONED"}] + lappend summarylines " $tag [dict get $finding class] overlap: $fa vs $fb - witness arglist {[dict get $finding witness]} parses cleanly against both forms" + foreach slot [dict get $finding slots] { + lassign [dict get $slot args] arga argb + lappend summarylines " word '[dict get $slot word]' satisfies $fa/$arga and $fb/$argb ([dict get $slot relation])" + } + } + if {![dict size $findings]} { + lappend summarylines " no overlapping form pairs detected (static analysis - see the punk::args::formcheck help for the miss/report boundary)" + } + set summary [join $summarylines \n] + if {$opt_return eq "summary"} { + return $summary + } + return [dict create id $id form_names $form_names pairs $pairs findings $findings unsanctioned $unsanctioned summary $summary] + } + lappend PUNKARGS [list { @id -id ::punk::args::parse_status @cmd -name punk::args::parse_status\ diff --git a/src/modules/punk/args-buildversion.txt b/src/modules/punk/args-buildversion.txt index 44a5f015..0f58f7fc 100644 --- a/src/modules/punk/args-buildversion.txt +++ b/src/modules/punk/args-buildversion.txt @@ -1,6 +1,7 @@ -0.11.2 +0.12.0 #First line must be a semantic version number #all other lines are ignored. +#0.12.0 - G-074: new punk::args::formcheck - on-demand multiform ambiguity analysis. Static pairwise pass over a definition's resolved FORMS: enumerates the positional word-slot chains each form can present (leaders then values, branching on -optional arguments and ?-wrapped optional clause members, -multiple capped; options excluded - order-free), derives candidate witness arglists for aligned equal-length chains (discriminator words + type-derived witnesses, screened via choiceword_match/type tests so screening can't diverge from parse acceptance), and only reports a form pair after CONFIRMING a witness with a real single-form parse against BOTH forms (parse_status; no user-supplied words, nothing added to define/resolve cost) - so fully discriminated pairs cannot false-alarm and every reported witness is a genuine multipleformmatches arglist; the documented miss direction is witness derivation (exotic types, forms requiring options, enumeration caps). Findings classify as type_weakness (a discriminator slot - literal()/literalprefix()/restricted choices - aligned with a permissive non-validating type: any/none/string/ansistring/globstring/expr/script; the 'lseq 1 count 5' class) vs structural (forms genuinely share an argument shape; the 'after cancel id|script' class). New @form key -overlapallowed sanctions a KNOWN overlap on either pair member: the finding reports with sanctioned 1 and leaves the unsanctioned list (the actionable/gate subset) - parse behaviour is never affected (multipleformmatches still raises); unknown form names rejected at definition resolve. Returns machine-parsable dict (id/form_names/pairs/findings with witness+per-slot relations/unsanctioned/summary) or -return summary for the report text. New testsuite formcheck.test; @form directive doc updated. Proving consumers: tclcore ::lseq (reports range/start_count AND range/count - both real, root cause the expr-typed end slot) and ::after (exactly the sanctioned cancelid/cancelscript documented overlap). #0.11.2 - bad-@dynamic warn-once + round-1 caching (user-reported: 'i join' emitted the "bad @dynamic tag" warning 4x, 'i join test' 6x): a @dynamic definition whose round-1 tstr output contains no round-2 parameters previously bypassed argdefcache_unresolved entirely, so EVERY resolve redid display masking plus the full round-1 tstr and re-warned - each 'i' invocation resolves several times (doc walk, advisory parse, get_spec for the render, synopsis), all cache hits for static definitions but full re-work for bad-dynamic ones. Such definitions are now cached as a zero-param unresolved entry: subsequent resolves take the cheap cached branch (consistent with the round-1 freezing legitimately dynamic definitions already get) and the warning emits once per definition per interp. Warning message corrected while there: @dynamic is NOT a complete no-op for a parse-inert definition - deferred display fields still re-expand per render instead of caching (expand_display_fields spec_dynamic gate), so the message now says removal is appropriate only if that display behaviour is unintended. Legitimately dynamic definitions unaffected (round-2 re-substitution pinned live). Also commented the dev diagnostics dump (puts of the full records list + ::testrecord global) on resolve's malformed-record error path - the raised message already carries the offending record; found when the malformed ::tcl_startOfNextWord tclcore definition triggered it (fixed in tclcore 0.3.2). New testsuite args/dynamic.test (warn-once + cached-parse pin, legit-dynamic round-2 freshness pin, stderr captured via channel transform). #0.11.1 - documentation-only: define -help gains a 'Registration styles' section (direct define vs deferred lappend-PUNKARGS + register::NAMESPACES registration - lazy @id scan and on-demand definition via update_definitions, the module-template/moduledoc style, PUNKARGS_aliases, punk::args::status timings; prefer deferred for anything large) and an 'Interpolation (tstr placeholders) and the defspace' section (display-field deferral vs parse-field expansion at first resolve vs @dynamic re-expansion; defspace rule: direct define = calling namespace, registered PUNKARGS = the argdoc child namespace when it exists even if the PUNKARGS variable is in the parent; unresolvable placeholders left silently literal - check the defspace when a literal ${...} appears; robust patterns for load-time-computed values: explicit tstr pre-expansion, build-time string-map token, or setting the variable in argdoc). Motivated by the ::after id-shape harvest misattribution (2026-07-13, corrected record in goals/G-055). #0.11.0 - G-041 increment 2 (doc-surface support): synopsis renderer honours the documented @form -synopsis override - the stored override now replaces the auto-calculated synopsis line in punk::args::synopsis full and summary renders (arg_error's synopsis section honoured it already; the per-form dict gains a 'synopsis' key when overridden, FORMARGS unchanged for dict consumers) - forms.test GAP forms_form_synopsis_override_stored_not_rendered_GAP flipped to forms_form_synopsis_override_rendered. Candidate-form ranking extended to choice discriminators: form_literal_affinity now treats a required argument with a RESTRICTED choice set as a discriminator (matched via choiceword_match, the shared G-040 resolver) alongside literal()/literalprefix() types - the tclcore models express subcommand-ish literals as -choices (e.g after's cancel/idle/info), so 'after cancel' now ranks the cancel forms first in noformmatch errors and parse_status best-candidate selection instead of falling back to declaration order. diff --git a/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm b/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm index 59f7212f..c7117c49 100644 --- a/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm +++ b/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm @@ -4591,7 +4591,11 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { #@form -form {cancelid} -synopsis "after cancel id" - @form -form {cancelid} + #The cancelid/cancelscript overlap is DOCUMENTED behaviour (an id-shaped word + #is genuinely ambiguous - see the id -type comment below), so it is sanctioned + #for punk::args::formcheck reporting (G-074). Parse behaviour is unaffected: + #'after cancel ' still raises multipleformmatches. + @form -form {cancelid} -overlapallowed {cancelscript} @leaders -min 1 -max 1 cancel -choices {cancel} @values -min 1 -max 1 diff --git a/src/modules/punk/args/moduledoc/tclcore-buildversion.txt b/src/modules/punk/args/moduledoc/tclcore-buildversion.txt index fa6c6fa9..74d2cca2 100644 --- a/src/modules/punk/args/moduledoc/tclcore-buildversion.txt +++ b/src/modules/punk/args/moduledoc/tclcore-buildversion.txt @@ -1,6 +1,7 @@ -0.3.3 +0.3.4 #First line must be a semantic version number #all other lines are ignored. +#0.3.4 - G-074: the documented cancelid/cancelscript overlap on ::after cancel is sanctioned via the new @form -overlapallowed key (punk::args 0.12.0) - punk::args::formcheck now reports it as an acknowledged (sanctioned) structural overlap rather than an actionable finding, leaving ::after with zero unsanctioned findings. Parse behaviour unchanged: an id-shaped 'after cancel' word still raises multipleformmatches (the runtime-liveness ambiguity real Tcl resolves by trying the id first - 0.3.0 record). ::lseq deliberately NOT sanctioned: its range/start_count and range/count overlaps are type-weakness findings (the expr-typed end slot swallows the 'count'/'by' discriminator words) - kept visible pending an expr syntax-validating type (G-069/G-070 territory, G-055 operand-typing record). #0.3.3 - removed the parse-inert @dynamic tags from ::split, ::array and ::join (user-directed; identified by the 0.3.2 sweep). None has round-2 substitution content, and their ${...} placeholders are all display-field styling/examples - the definitions now resolve as ordinary static definitions with display expansion cached per raw definition (previously @dynamic forced display re-expansion on every render). No bad-@dynamic warnings remain across the module's 462 registered ids; renders and parses verified unchanged for all three. #0.3.2 - fixed malformed ::tcl_startOfNextWord definition: its -help was double-quoted but the embedded man-page example contains inner double quotes (set theString "The quick brown fox" / puts "Word start index: ..."), so the value terminated early and the definition failed to resolve at all (punk::args::resolve 'bad optionspecs line' error; 'i tcl_startOfNextWord' broken). The -help is now braced (fully literal per the define quoting rules - inner quotes and brackets safe, text verbatim, example braces balance). Found by a bad-@dynamic sweep across all 462 registered ids (punk::args 0.11.2 work); the same sweep identified the parse-inert @dynamic tags on ::split, ::array and ::join (each now warns once per interp) - left in place pending a decision on their display-refresh semantics (@dynamic still forces display-field re-expansion per render). #0.3.1 - authoring-style only (user-directed): the ::after id-shape harvest is consumed via tstr ${$after_id_prefix} placeholders instead of the 0.3.0 build-time %AFTERIDPREFIX% string map - the harvest variable now lives in the argdoc namespace (the defspace registered PUNKARGS definitions resolve placeholders in when an argdoc child exists; see the punk::args::define 'Interpolation and the defspace' help section), which makes plain placeholders work in both the -type parse field (expanded at first resolve) and the -help display fields (expanded at display time). This module showcases the tstr style; string map remains reserved for cases where build-time substitution is genuinely necessary. Behaviour identical to 0.3.0 (resolved -type, form discrimination, parity pins and help renders re-verified). diff --git a/src/tests/modules/punk/args/testsuites/args/formcheck.test b/src/tests/modules/punk/args/testsuites/args/formcheck.test new file mode 100644 index 00000000..d81f9219 --- /dev/null +++ b/src/tests/modules/punk/args/testsuites/args/formcheck.test @@ -0,0 +1,195 @@ +package require tcltest + +package require punk::args + +#G-074: punk::args::formcheck - on-demand multiform ambiguity analysis with +#sanctioned-overlap annotation (@form -overlapallowed). +#A finding is only reported after a synthetic witness arglist is CONFIRMED by a real +#single-form parse against both forms, so fully discriminated form pairs cannot +#false-alarm; witness derivation is the documented miss direction (exotic types, +#forms requiring options, capped -multiple repetition). The sanction is +#formcheck-reporting metadata only - parse behaviour (multipleformmatches) is +#unaffected. The tclcore ::lseq and ::after models are the motivating real cases +#from the G-041 closeout (goals/archive/G-041-punkargs-form-matching.md). + +namespace eval ::testspace { + namespace import ::tcltest::* + variable common { + set result "" + } + + testConstraint have_tclcoredocs [expr {![catch {package require punk::args::moduledoc::tclcore}]}] + + #discriminated multiform fixtures - literal/choice/int leading slots (no permissive + #alignment) and arity-window separation. formcheck must report NOTHING for these. + punk::args::define { + @id -id ::testspace::fc_afterish + @cmd -name testspace::fc_afterish -summary "after-like multiform" -help "discriminated multiform fixture" + @form -form ms + @values -min 1 -max -1 + ms -type int + script -type string -optional 1 -multiple 1 + @form -form cancel + @values -min 2 -max -1 + cancel -type literal(cancel) + ids -type string -multiple 1 + @form -form idle + @values -min 2 -max -1 + idle -type literal(idle) + scripts -type string -multiple 1 + } + punk::args::define { + @id -id ::testspace::fc_sharedform + @cmd -name testspace::fc_sharedform -summary "shared-prologue multiform" -help "arity-discriminated multiform fixture" + @form -form {get set} + @leaders -min 1 -max 1 + key -type string + @form -form get + @values -min 0 -max 0 + @form -form set + @values -min 1 -max 1 + newvalue -type string + } + + #overlapping fixture: aa's typed slot faces bb's permissive slot (type-weakness), + #with the pair sanctioned on ONE member via @form -overlapallowed + punk::args::define { + @id -id ::testspace::fc_sanctioned + @cmd -name testspace::fc_sanctioned -summary "sanctioned overlap" -help "sanctioned overlapping multiform fixture" + @form -form go -overlapallowed {run} + @values -min 2 -max 2 + go -type literal(go) + target -type string + @form -form run + @values -min 2 -max 2 + mode -type any + target -type string + } + + test formcheck_discriminated_no_findings {formcheck reports nothing for fully discriminated multiform definitions (fixtures + the parse withid/withdef pair)}\ + -setup $common -body { + foreach id {::testspace::fc_afterish ::testspace::fc_sharedform ::punk::args::parse} { + set r [punk::args::formcheck $id] + lappend result [list [dict size [dict get $r findings]] [dict get $r unsanctioned]] + } + set result + }\ + -cleanup { + }\ + -result [list {0 {}} {0 {}} {0 {}}] + + test formcheck_finding_classes_and_sanction {an overlap is classified (type-weakness = discriminator vs permissive) and -overlapallowed on one member downgrades the pair to sanctioned}\ + -setup $common -body { + set r [punk::args::formcheck ::testspace::fc_sanctioned] + set finding [dict get $r findings {go run}] + lappend result [dict get $finding class] + lappend result [dict get $finding sanctioned] + lappend result [dict get $r unsanctioned] + #the reported witness genuinely parses against both forms + lappend result [dict get [punk::args::parse_status [dict get $finding witness] -form go withid ::testspace::fc_sanctioned] ok] + lappend result [dict get [punk::args::parse_status [dict get $finding witness] -form run withid ::testspace::fc_sanctioned] ok] + }\ + -cleanup { + }\ + -result [list type_weakness 1 {} 1 1] + + test formcheck_overlapallowed_unknown_form_rejected {@form -overlapallowed naming an unknown form is rejected when the definition resolves}\ + -setup $common -body { + punk::args::define { + @id -id ::testspace::fc_badsanction + @form -form aa -overlapallowed {nosuchform} + @values -min 1 -max 1 + x -type string + @form -form bb + @values -min 1 -max 1 + y -type any + } + if {[catch {punk::args::get_spec ::testspace::fc_badsanction} errmsg]} { + lappend result [string match "*-overlapallowed*unknown form 'nosuchform'*" $errmsg] + } else { + lappend result UNEXPECTED-resolved + } + set result + }\ + -cleanup { + catch {punk::args::undefine ::testspace::fc_badsanction 1} + }\ + -result [list 1] + + test formcheck_return_summary {-return summary returns the human report text only}\ + -setup $common -body { + set s [punk::args::formcheck -return summary ::testspace::fc_sanctioned] + lappend result [string match "punk::args::formcheck ::testspace::fc_sanctioned:*" $s] + lappend result [string match "*sanctioned type_weakness overlap: go vs run*" $s] + #dict return carries the same text under the summary key + lappend result [expr {$s eq [dict get [punk::args::formcheck ::testspace::fc_sanctioned] summary]}] + }\ + -cleanup { + }\ + -result [list 1 1 1] + + test formcheck_lseq_typeweakness {tclcore ::lseq reports the range/start_count expr-typed-end overlap as an unsanctioned type-weakness finding ('lseq 1 count 5' class)}\ + -constraints have_tclcoredocs\ + -setup $common -body { + set r [punk::args::formcheck ::lseq] + set finding [dict get $r findings {range start_count}] + lappend result [dict get $finding class] + lappend result [dict get $finding sanctioned] + lappend result [expr {{range start_count} in [dict get $r unsanctioned]}] + #the witness word for the aligned discriminator slot is start_count's + #literalprefix(count) word, swallowed by range's number|expr end slot + set discword "" + foreach slot [dict get $finding slots] { + if {[dict get $slot relation] eq "discriminator_vs_permissive"} { + set discword [dict get $slot word] + } + } + lappend result $discword + #every reported ::lseq witness genuinely parses against both its forms + dict for {pairkey pf} [dict get $r findings] { + lassign $pairkey fa fb + if {![dict get [punk::args::parse_status [dict get $pf witness] -form $fa withid ::lseq] ok] + || ![dict get [punk::args::parse_status [dict get $pf witness] -form $fb withid ::lseq] ok]} { + lappend result [list unconfirmed-witness $pairkey] + } + } + set result + }\ + -cleanup { + }\ + -result [list type_weakness 0 1 count] + + test formcheck_after_cancel_sanctioned {tclcore ::after reports exactly the documented cancelid/cancelscript overlap - structural class, sanctioned via -overlapallowed, leaving no unsanctioned findings}\ + -constraints have_tclcoredocs\ + -setup $common -body { + set r [punk::args::formcheck ::after] + lappend result [dict keys [dict get $r findings]] + lappend result [dict get $r findings {cancelid cancelscript} class] + lappend result [dict get $r findings {cancelid cancelscript} sanctioned] + lappend result [dict get $r unsanctioned] + }\ + -cleanup { + }\ + -result [list {{cancelid cancelscript}} structural 1 {}] + + test formcheck_sanction_does_not_affect_parse {the -overlapallowed sanction never changes parse behaviour - an ambiguous 'after cancel ' still raises multipleformmatches}\ + -constraints have_tclcoredocs\ + -setup $common -body { + if {[catch {punk::args::parse {cancel after#1} withid ::after} errmsg erroropts]} { + set classinfo [lindex [dict get $erroropts -errorcode] 2] + lappend result [lindex $classinfo 0] + } else { + lappend result UNEXPECTED-parsed + } + set result + }\ + -cleanup { + }\ + -result [list multipleformmatches] + + #fixture cleanup + catch {punk::args::undefine ::testspace::fc_afterish 1} + catch {punk::args::undefine ::testspace::fc_sharedform 1} + catch {punk::args::undefine ::testspace::fc_sanctioned 1} +} +tcltest::cleanupTests ;#needed to produce test summary line.