Browse Source

G-041 increment 1: multi-form candidacy engine (punk::args 0.10.0, project 0.12.14)

punk::args::parse/get_dict with the default -form * (or any multi-form
selection) now attempts every permitted form instead of effectively
parsing form 0 only. Exactly one clean match auto-selects (result gains
a 'form' key; 'formstatus' reports every candidate when candidacy ran).
No match raises a 'noformmatch' validation error naming each candidate
form's first-line failure, ranked best-candidate first (leading-literal
affinity with the supplied words, then incomplete before invalid, then
declaration order). Several clean matches raise 'multipleformmatches'
naming the forms - deliberately no silent preference (recorded in the
goal detail); callers pass -form to disambiguate.

-form now accepts the documented list of form names/indices across
get_dict, parse, parse_status and arg_error via a shared resolver
(private::form_selection). arg_error renders the argument table for the
first listed form and marks all listed forms' synopsis entries; parse's
error render passes the ranked candidate list so the closest form's
argument table shows under the no-match message.

parse_status: 'form' is now the matched (or best-candidate) form - the
per-argument statuses and badarg marking are built for it - and the new
documented 'formstatus' key carries per-form status/failureclass/badarg/
message (caller-attributed), the per-form compatibility surface the
G-044 completion/hinting consumer needs on partial argument lists.

Engine restructure: the single-form parse body of get_dict extracted
verbatim to private::get_dict_form (argspecs resolved in the caller's
context before selection; no caller-frame use inside - verified).
Single-form definitions take the direct path unchanged.

Tests: forms.test GAP pins flipped (forms_parse_autoselect,
forms_parse_formlist_restriction) plus new coverage: shared-prologue
arity discrimination, noformmatch ranking + errorcode payload,
multipleformmatches + explicit -form disambiguation, formstatus in
results and parse_status. punk::args 198 pass / 1 pre-existing skip,
punk::ns 53/53, punk::lib 35/35.

Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
Julian Noble 3 days ago
parent
commit
d85608d685
  1. 4
      CHANGELOG.md
  2. 36
      goals/G-041-punkargs-form-matching.md
  3. 2
      punkproject.toml
  4. 398
      src/modules/punk/args-999999.0a1.0.tm
  5. 3
      src/modules/punk/args-buildversion.txt
  6. 165
      src/tests/modules/punk/args/testsuites/args/forms.test

4
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` Entries are newest-first; one bullet per notable change. See the root `AGENTS.md`
"Project Versioning" section for the bump policy. "Project Versioning" section for the bump policy.
## [0.12.14] - 2026-07-13
- punk::args 0.10.0 (G-041 increment): multi-form argument definitions now parse by automated form selection - punk::args::parse without -form attempts every form and auto-selects the one that cleanly matches ('lseq'-style multiform commands no longer fail with the first form's error when the arguments fit a later form). No matching form raises an error naming each candidate form's failure (best candidate first); arguments matching several forms raise an error naming them, with -form (which now accepts the documented list of form names/indices) restricting to the intended form. Parse results and parse_status report the selected form and every candidate's status ('form'/'formstatus' keys).
## [0.12.13] - 2026-07-13 ## [0.12.13] - 2026-07-13
- G-051 achieved: punk::ns 0.4.0 - the help system's doc walk now accepts the same choice-word abbreviations parsing accepts: 'i string is tr' resolves to the 'string is true' documentation exactly as 'string is tr 1' executes (unique prefixes, aliases, nocase; ambiguous/denied/unknown words stay at the parent exactly when parse rejects them). cmdinfo also reports the truthful cmdtype 'doconly' (was 'notfound') for documentation-only levels such as 'string is <class>' and documented TclOO method docids. punk::lib 0.4.1 adapts its script analysis to the new value with identical behaviour. - G-051 achieved: punk::ns 0.4.0 - the help system's doc walk now accepts the same choice-word abbreviations parsing accepts: 'i string is tr' resolves to the 'string is true' documentation exactly as 'string is tr 1' executes (unique prefixes, aliases, nocase; ambiguous/denied/unknown words stay at the parent exactly when parse rejects them). cmdinfo also reports the truthful cmdtype 'doconly' (was 'notfound') for documentation-only levels such as 'string is <class>' and documented TclOO method docids. punk::lib 0.4.1 adapts its script analysis to the new value with identical behaviour.

36
goals/G-041-punkargs-form-matching.md

@ -62,6 +62,42 @@ mechanism should be exposed as an API that accepts an incomplete argument list a
per-form compatibility (not only an all-or-nothing full parse). Design for that consumer per-form compatibility (not only an all-or-nothing full parse). Design for that consumer
when shaping step 1. when shaping step 1.
## Progress
- 2026-07-13 increment 1 (engine - punk::args 0.10.0, project 0.12.14): multi-form
candidacy implemented in get_dict. The single-form parse body was extracted verbatim
to private::get_dict_form (no caller-frame use inside - verified; resolve still runs
in the caller's context before selection). -form * / multi-form selections attempt
each permitted form: exactly one clean match auto-selects; none raises 'noformmatch'
naming each candidate form's first-line failure; several raise 'multipleformmatches'
naming the forms. -form list support landed across get_dict/parse/parse_status/
arg_error via the shared private::form_selection resolver (supplied order preserved;
arg_error renders the argument table for the first listed form and marks all listed
forms' synopsis entries). Results gain 'form' (+'formstatus' when candidacy ran);
parse_status 'form' is the matched/best-candidate form and its new 'formstatus' key
is the per-form compatibility surface designed for the G-044 hinting consumer.
DECISIONS RECORDED:
- Several clean matches ERROR rather than silently preferring first-declared (the
acceptance wording; a silent pick could validate against an unintended form and
return a wrong values shape - callers with a preference pass -form).
- Candidate ranking (display/status only - candidacy always from real parse
attempts, no literal fast-path skipping): leading-literal affinity of each form
with the supplied words (agreeing literal(x)/literalprefix(x) leading run scores
up, first disagreement disqualifies), then incomplete before invalid, then
declaration order. Known limits noted in form_literal_affinity: no alignment
through received options; choice-discriminated forms score 0 (refinable).
- Literal-discrimination pre-pass as a parse fast path (approach step 2) deferred
as a perf refinement: correctness must come from real parse attempts, and the
affinity heuristic's word alignment is not exact through options.
Tests: forms.test GAPs flipped (forms_parse_autoselect,
forms_parse_formlist_restriction) + noformmatch ranking/errorcode,
multipleformmatches, shared-prologue arity discrimination, formstatus coverage.
punk::args 198/199 (1 pre-existing skip), punk::ns 53/53, punk::lib 35/35.
Remaining: doc-surface increment (cmdhelp best-form presentation via parse_status
form key - cmdhelp's -form default is still 0; synopsis closest-form marking), live
tclcore verification ('lseq 3', switch block form), @form -synopsis override GAP
(adjacent - decide in doc-surface increment).
## Alternatives considered ## Alternatives considered
- Documenting alternate forms as separate subhelp choiceinfo entries (the trace-style - Documenting alternate forms as separate subhelp choiceinfo entries (the trace-style

2
punkproject.toml

@ -1,4 +1,4 @@
[project] [project]
name = "punkshell" name = "punkshell"
version = "0.12.13" version = "0.12.14"
license = "BSD-2-Clause" license = "BSD-2-Clause"

398
src/modules/punk/args-999999.0a1.0.tm

@ -5094,24 +5094,12 @@ tcl::namespace::eval punk::args {
} }
} }
set formnames [dict get $spec_dict form_names] set formnames [dict get $spec_dict form_names]
if {[string is integer -strict $form]} { #G-041: -form accepts a list of form names/indices - supplied order is preserved
if {$form < 0 || $form > [llength $formnames]-1} { #(the first selected form is the one the argument table renders; all selected
set arg_error_isrunning 0 #forms have their synopsis entries marked)
error "arg_error invalid value for option -form. Received '$v' Allowed values 0-[expr {[llength $formnames]-1}] or one of '$formnames'" if {[catch {private::form_selection $formnames $form "arg_error"} selected_forms]} {
} set arg_error_isrunning 0
set selected_forms [list [lindex $formnames $form]] error "arg_error invalid value for option -form. Received '$form' Allowed values 0-[expr {[llength $formnames]-1}] or one of '$formnames'"
} else {
if {$form eq "*"} {
set selected_forms $formnames
} else {
set fmatch [tcl::prefix::match -error "" $formnames $form]
if {$fmatch ne ""} {
set selected_forms [list $fmatch]
} else {
set arg_error_isrunning 0
error "arg_error invalid value for option -form. Received '$v' Allowed values 0-[expr {[llength $formnames]-1}] or one of '$formnames'"
}
}
} }
@ -6351,6 +6339,12 @@ tcl::namespace::eval punk::args {
to another procedure which also requires solos, because the opts dict contains to another procedure which also requires solos, because the opts dict contains
solo flags with a 1 value or a list of 1's if it was a solo with -multiple true solo flags with a 1 value or a list of 1's if it was a solo with -multiple true
specified. specified.
The form key records the name of the form the arguments were parsed against
(multiform definitions declare forms with the @form directive - see
punk::args::define). When -form permits several forms, the form that
auto-selection settled on is reported here, and a formstatus key is added
recording each attempted form's outcome (see punk::args::parse_status).
} }
@form -form {withid withdef} @form -form {withid withdef}
@leaders -min 1 -max 1 @leaders -min 1 -max 1
@ -6362,7 +6356,16 @@ tcl::namespace::eval punk::args {
"Restrict parsing to the set of forms listed. "Restrict parsing to the set of forms listed.
Forms are the orthogonal sets of arguments a Forms are the orthogonal sets of arguments a
command can take - usually described in 'synopsis' command can take - usually described in 'synopsis'
entries." entries. Each list element is an ordinal index or
a form name.
With the default * (or a multi-form selection) the
arguments are attempted against each permitted form:
a clean match against exactly one form is
auto-selected (the result's 'form' key records it),
no match raises an error naming each candidate
form's failure, and matches against several forms
raise an error naming them - pass a single form to
disambiguate."
#default to enhanced errorstyle despite slow 'catch' (unhappy path) performance #default to enhanced errorstyle despite slow 'catch' (unhappy path) performance
#todo - configurable per interp/namespace #todo - configurable per interp/namespace
-errorstyle -type string -default enhanced -choices {enhanced standard basic minimal} -errorstyle -type string -default enhanced -choices {enhanced standard basic minimal}
@ -6537,6 +6540,24 @@ tcl::namespace::eval punk::args {
} else { } else {
set msg [string map [list %caller% [Get_caller]] $msg] set msg [string map [list %caller% [Get_caller]] $msg]
} }
#G-041: display-form selection for the usage render. For the multi-form
#candidacy failures the engine reports, show the candidate forms rather than
#the caller's (usually *) -form selection - best candidate first so its
#argument table renders (arg_error marks all listed forms in the synopsis).
set displayform [dict get $opts -form]
set classinfo [lindex $ecode 2]
switch -- [lindex $classinfo 0] {
noformmatch {
set failuredict [lrange $ecode 3 end]
if {[dict exists $failuredict -formerrors]} {
#ranked best-first at raise time (see rank_form_failures)
set displayform [dict keys [dict get $failuredict -formerrors]]
}
}
multipleformmatches {
set displayform [Dict_getdef [lrange $classinfo 1 end] forms $displayform]
}
}
switch -- $matched_errorstyle { switch -- $matched_errorstyle {
minimal { minimal {
#return -options [list -code error -errorcode $ecode] $msg #return -options [list -code error -errorcode $ecode] $msg
@ -6548,7 +6569,7 @@ tcl::namespace::eval punk::args {
set argspecs [Dict_getdef $customdict -argspecs ""] set argspecs [Dict_getdef $customdict -argspecs ""]
set badarg [Dict_getdef $customdict -badarg ""] set badarg [Dict_getdef $customdict -badarg ""]
if {$argspecs ne ""} { if {$argspecs ne ""} {
set msg [arg_error $msg $argspecs -aserror 0 -return string -badarg $badarg -form [dict get $opts -form]] set msg [arg_error $msg $argspecs -aserror 0 -return string -badarg $badarg -form $displayform]
} }
#return -options [list -code error -errorcode $ecode] $msg #return -options [list -code error -errorcode $ecode] $msg
set elist [list -options [list -code error -errorcode $ecode] $msg] set elist [list -options [list -code error -errorcode $ecode] $msg]
@ -6558,7 +6579,7 @@ tcl::namespace::eval punk::args {
set argspecs [Dict_getdef $customdict -argspecs ""] set argspecs [Dict_getdef $customdict -argspecs ""]
set badarg [Dict_getdef $customdict -badarg ""] set badarg [Dict_getdef $customdict -badarg ""]
if {$argspecs ne ""} { if {$argspecs ne ""} {
set msg [arg_error $msg $argspecs -aserror 0 -badarg $badarg -form [dict get $opts -form]] set msg [arg_error $msg $argspecs -aserror 0 -badarg $badarg -form $displayform]
} }
#return -options [list -code error -errorcode $ecode] $msg #return -options [list -code error -errorcode $ecode] $msg
set elist [list -options [list -code error -errorcode $ecode] $msg] set elist [list -options [list -code error -errorcode $ecode] $msg]
@ -6577,7 +6598,7 @@ tcl::namespace::eval punk::args {
append msg \n [punk::lib::showdict -roottype list $estack */*] append msg \n [punk::lib::showdict -roottype list $estack */*]
} }
if {$argspecs ne ""} { if {$argspecs ne ""} {
set msg [arg_error $msg $argspecs -aserror 0 -badarg $badarg -form [dict get $opts -form]] set msg [arg_error $msg $argspecs -aserror 0 -badarg $badarg -form $displayform]
append msg \n "::errorCode summary: $ecode_summary" append msg \n "::errorCode summary: $ecode_summary"
#return -options [list -code error -errorcode $ecode] $msg #return -options [list -code error -errorcode $ecode] $msg
set elist [list -options [list -code error -errorcode $ecode] $msg] set elist [list -options [list -code error -errorcode $ecode] $msg]
@ -6632,6 +6653,14 @@ tcl::namespace::eval punk::args {
} }
return invalid return invalid
} }
noformmatch {
#G-041 multi-form candidacy: payload is: forms <fids> classes <per-form statuses>
#incomplete when some candidate form needs only more words
if {"incomplete" in [Dict_getdef $payload classes {}]} {
return incomplete
}
return invalid
}
default { default {
return invalid return invalid
} }
@ -6649,8 +6678,10 @@ tcl::namespace::eval punk::args {
-message "" -message ""
-errorcode "" -errorcode ""
-failureclass "" -failureclass ""
-argfailureclass ""
-badarg "" -badarg ""
-parsedargs {} -parsedargs {}
-formstatus {}
}] }]
set opts [dict merge $defaults $args] set opts [dict merge $defaults $args]
set parsedargs [dict get $opts -parsedargs] set parsedargs [dict get $opts -parsedargs]
@ -6698,7 +6729,14 @@ tcl::namespace::eval punk::args {
set received [llength $argpositions] set received [llength $argpositions]
if {$arg eq $badarg} { if {$arg eq $badarg} {
set status bad set status bad
set argfailclass [dict get $opts -failureclass] #G-041: for the multi-form noformmatch failure the badarg belongs to the
#best-candidate form - its own failureclass (via -argfailureclass) is the
#accurate per-argument classification, the overall failureclass stays
#truthful to the errorcode
set argfailclass [dict get $opts -argfailureclass]
if {$argfailclass eq ""} {
set argfailclass [dict get $opts -failureclass]
}
} elseif {$received > 0} { } elseif {$received > 0} {
set status ok set status ok
set argfailclass "" set argfailclass ""
@ -6729,31 +6767,122 @@ tcl::namespace::eval punk::args {
} badarg $badarg {*}{ } badarg $badarg {*}{
} id [Dict_getdef $spec_dict id ""] {*}{ } id [Dict_getdef $spec_dict id ""] {*}{
} form $fid {*}{ } form $fid {*}{
} formstatus [dict get $opts -formstatus] {*}{
} receivednames $receivednames {*}{ } receivednames $receivednames {*}{
} argstatus $argstatus {*}{ } argstatus $argstatus {*}{
}] }]
} }
#resolve the form name whose argument set parse-status per-argument entries cover #G-041: resolve a -form selection to a list of form names.
#(first form matching the -form selection - mirrors arg_error's display-form resolution) #formselection is * (all forms) or a list whose elements are each an ordinal index or
proc private::parse_status_formname {spec_dict formselection} { #a form name (prefix-matchable). Supplied order is preserved (first element is the
set formnames [dict get $spec_dict form_names] #primary/display form for consumers that need a single form), duplicates removed.
set first [lindex $formselection 0] #Raises an error naming $errprefix for an unrecognised element.
if {$formselection eq "*" || $formselection eq ""} { proc private::form_selection {form_names formselection {errprefix punk::args}} {
return [lindex $formnames 0] if {$formselection eq "*" || $formselection eq "" || "*" in $formselection} {
} return $form_names
if {[string is integer -strict $first]} { }
set fid [lindex $formnames $first] set selected [list]
if {$fid ne ""} { foreach f $formselection {
return $fid if {[string is integer -strict $f]} {
if {$f < 0 || $f > [llength $form_names]-1} {
error "$errprefix invalid -form value '$f' Expected int 0-[expr {[llength $form_names]-1}] or one of '$form_names'"
}
set fid [lindex $form_names $f]
} else {
set fid [tcl::prefix::match -error "" $form_names $f]
if {$fid eq ""} {
error "$errprefix invalid -form value '$f' Expected int 0-[expr {[llength $form_names]-1}] or one of '$form_names'"
}
}
if {$fid ni $selected} {
lappend selected $fid
} }
return [lindex $formnames 0]
} }
set fmatch [tcl::prefix::match -error "" $formnames $first] return $selected
if {$fmatch ne ""} { }
return $fmatch
#G-041: leading-literal affinity of a form for the supplied words - the ranking signal
#for candidate forms when no form parses cleanly (many multiform commands discriminate
#on a leading literal, e.g 'after cancel id').
#Walks the form's leading run of required single-member literal-typed arguments
#(leaders then values) against the corresponding words: +1 per agreement, and a large
#negative on the first disagreement (the form's discriminator word was not supplied).
#Heuristic for ranking/display only - candidacy itself always comes from real parse
#attempts. Known limits (recorded in G-041): no alignment through received options,
#choice-discriminated forms score 0.
proc private::form_literal_affinity {argspecs fid rawargs} {
set formdict [dict get $argspecs FORMS $fid]
set ARG_INFO [dict get $formdict ARG_INFO]
set score 0
set widx 0
foreach argname [list {*}[dict get $formdict LEADER_NAMES] {*}[dict get $formdict VAL_NAMES]] {
if {$widx >= [llength $rawargs]} {
break
}
if {[dict get $ARG_INFO $argname -optional]} {
break
}
set typelist [dict get $ARG_INFO $argname -type]
if {[llength $typelist] != 1} {
break
}
set tp [lindex $typelist 0]
if {[string match {\?*\?} $tp]} {
break
}
set word [lindex $rawargs $widx]
set is_literal 0
set word_matched 0
foreach alt [split $tp |] {
if {[string match {literal(*)} $alt]} {
set is_literal 1
if {$word eq [string range $alt 8 end-1]} {
set word_matched 1
break
}
} elseif {[string match {literalprefix(*)} $alt]} {
set is_literal 1
set lit [string range $alt 14 end-1]
if {$word ne "" && [string equal -length [string length $word] $word $lit]} {
set word_matched 1
break
}
}
}
if {!$is_literal} {
break
}
if {$word_matched} {
incr score
} else {
incr score -1000
break
}
incr widx
} }
return [lindex $formnames 0] return $score
}
#G-041: order a formfailures dict (fid -> {status .. failureclass .. badarg .. message ..})
#best-candidate first: literal affinity desc, then incomplete before invalid, then the
#incoming (declaration) order. Returns the re-ordered dict.
proc private::rank_form_failures {argspecs rawargs formfailures} {
set scored [list]
dict for {fid finfo} $formfailures {
set negaffinity [expr {-[form_literal_affinity $argspecs $fid $rawargs]}]
set classrank [expr {[dict get $finfo status] eq "incomplete" ? 0 : 1}]
lappend scored [list $fid $negaffinity $classrank]
}
#lsort is stable - sort least significant key first
set scored [lsort -integer -index 2 $scored]
set scored [lsort -integer -index 1 $scored]
set ranked [dict create]
foreach entry $scored {
set fid [lindex $entry 0]
dict set ranked $fid [dict get $formfailures $fid]
}
return $ranked
} }
lappend PUNKARGS [list { lappend PUNKARGS [list {
@ -6794,8 +6923,23 @@ tcl::namespace::eval punk::args {
badarg empty | name of the offending/unfillable argument badarg empty | name of the offending/unfillable argument
id the definition id id the definition id
form form name the per-argument statuses were built for form form name the per-argument statuses were built for
(the first form matching -form - the form usage (the form usage displays render). For multiform
displays render) definitions this is the parsed form when the parse
succeeded (auto-selected when -form permits several
- see punk::args::parse) and the best-candidate
form when no form matched (candidates ranked by
leading-literal affinity with the supplied words,
then incomplete before invalid, then declaration
order).
formstatus dict keyed by candidate form name - each value a
dict with at least the key 'status'
(valid | incomplete | invalid) and for failed
candidates failureclass, badarg and message.
Single-form parses report their one form; when
multi-form candidacy ran, every attempted form is
reported - partial-arglist consumers (e.g command
completion/hinting) can read per-form
compatibility from this key.
receivednames received argument names normalized to definition receivednames received argument names normalized to definition
argument names (opt aliases folded to their argument names (opt aliases folded to their
-alias|-name optionset) -alias|-name optionset)
@ -6888,7 +7032,13 @@ tcl::namespace::eval punk::args {
punk::args::parse $args withid ::punk::args::parse_status punk::args::parse $args withid ::punk::args::parse_status
} }
} }
set fid [private::parse_status_formname $spec_dict [dict get $opts -form]] #G-041: primary form of the caller's -form selection - the fallback display form
#when the parse outcome doesn't identify a better one (an invalid -form value is
#left to the parse call below to raise consistently)
if {[catch {private::form_selection [dict get $spec_dict form_names] [dict get $opts -form]} selected_forms]} {
set selected_forms [dict get $spec_dict form_names]
}
set fid [lindex $selected_forms 0]
set caller [dict get $opts -caller] set caller [dict get $opts -caller]
if {$caller eq ""} { if {$caller eq ""} {
#the frame walk parse would do by default names parse_status's own internal #the frame walk parse would do by default names parse_status's own internal
@ -6909,6 +7059,35 @@ tcl::namespace::eval punk::args {
set customdict [lrange $ecode 3 end] set customdict [lrange $ecode 3 end]
set badarg [Dict_getdef $customdict -badarg ""] set badarg [Dict_getdef $customdict -badarg ""]
set status [private::parse_status_classify $failureclass $payload] set status [private::parse_status_classify $failureclass $payload]
#G-041 multi-form candidacy failures: the per-argument statuses are built for
#the best-candidate form (ranked at raise time), with its badarg and its own
#failureclass for the argument marking; formstatus carries every candidate.
set argfailureclass ""
set formstatus [dict create]
switch -- $failureclass {
noformmatch {
set formerrors [Dict_getdef $customdict -formerrors {}]
if {[dict size $formerrors]} {
set fid [lindex [dict keys $formerrors] 0]
set bestinfo [dict get $formerrors $fid]
set badarg [dict get $bestinfo badarg]
set argfailureclass [dict get $bestinfo failureclass]
set formstatus $formerrors
}
}
multipleformmatches {
set matchedforms [Dict_getdef $payload forms {}]
if {[llength $matchedforms]} {
set fid [lindex $matchedforms 0]
foreach mf $matchedforms {
dict set formstatus $mf [dict create status valid]
}
}
}
default {
set formstatus [dict create $fid [dict create status $status failureclass $failureclass badarg $badarg message $r]]
}
}
#the -argspecs payload (the whole resolved spec) is display machinery - too bulky #the -argspecs payload (the whole resolved spec) is display machinery - too bulky
#for a status structure; keep the classification and the small custom keys #for a status structure; keep the classification and the small custom keys
set ecode_slim [lrange $ecode 0 2] set ecode_slim [lrange $ecode 0 2]
@ -6917,9 +7096,26 @@ tcl::namespace::eval punk::args {
lappend ecode_slim $k $v lappend ecode_slim $k $v
} }
} }
return [private::parse_status_build $spec_dict $fid -ok 0 -status $status -scheme error -message $r -errorcode $ecode_slim -failureclass $failureclass -badarg $badarg] #engine-level per-form failure messages retain the %caller% placeholder -
#apply the same attribution the overall message received
dict for {ffid finfo} $formstatus {
if {[dict exists $finfo message]} {
dict set formstatus $ffid message [string map [list %caller% $caller] [dict get $finfo message]]
}
}
return [private::parse_status_build $spec_dict $fid -ok 0 -status $status -scheme error -message $r -errorcode $ecode_slim -failureclass $failureclass -argfailureclass $argfailureclass -badarg $badarg -formstatus $formstatus]
}
#success - the parse result identifies the parsed form (auto-selected for
#multiform definitions - G-041) and, when candidacy ran, every candidate's status
set fid [Dict_getdef $r form $fid]
set formstatus [Dict_getdef $r formstatus [dict create $fid [dict create status valid]]]
#engine-level per-form failure messages retain the %caller% placeholder
dict for {ffid finfo} $formstatus {
if {[dict exists $finfo message]} {
dict set formstatus $ffid message [string map [list %caller% $caller] [dict get $finfo message]]
}
} }
return [private::parse_status_build $spec_dict $fid -ok 1 -status valid -scheme info -parsedargs $r] return [private::parse_status_build $spec_dict $fid -ok 1 -status valid -scheme info -parsedargs $r -formstatus $formstatus]
} }
#return number of values we can assign to cater for variable length clauses such as: #return number of values we can assign to cater for variable length clauses such as:
@ -9526,8 +9722,13 @@ tcl::namespace::eval punk::args {
"list of arguments to parse against the definition" "list of arguments to parse against the definition"
@opts @opts
-form -default * -help\ -form -default * -help\
"Ordinal index or name of the command form to parse against. "Restrict parsing to the listed forms - a list whose elements are
The default * considers all forms." each an ordinal index or name of a command form.
The default * attempts every form: an argument list cleanly
matching exactly one form is parsed against it (auto-selection),
matching none raises an error naming each candidate form's
failure, and matching several raises an error naming the
matching forms (pass a single form to disambiguate)."
}] }]
proc get_dict {deflist rawargs args} { proc get_dict {deflist rawargs args} {
#see arg_error regarding considerations around unhappy-path performance #see arg_error regarding considerations around unhappy-path performance
@ -9601,27 +9802,83 @@ tcl::namespace::eval punk::args {
#e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info, instance_info,id_info,form_names #e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info, instance_info,id_info,form_names
# ----------------------------------------------- # -----------------------------------------------
#we don't need all keys from argspecs - even if retrieving multiple as vars, generally faster than dict with #we don't need all keys from argspecs - even if retrieving multiple as vars, generally faster than dict with
set FORMS [dict get $argspecs FORMS]
set form_names [dict get $argspecs form_names] set form_names [dict get $argspecs form_names]
#G-041: -form accepts a list of form names/indices (default * = all forms)
set opt_form [dict get $proc_opts -form] set selected_forms [private::form_selection $form_names [dict get $proc_opts -form] "punk::args::get_dict"]
if {$opt_form eq "*"} {
set selected_forms $form_names if {[llength $selected_forms] == 1} {
} elseif {[string is integer -strict $opt_form]} { return [private::get_dict_form $argspecs [lindex $selected_forms 0] $rawargs]
if {$opt_form < 0 || $opt_form > [llength $form_names]-1} { }
error "punk::args::get_dict invalid -form value '$opt_form' Expected int 0-[expr {[llength $form_names]-1}] or one of '$form_names'"
#G-041 multi-form candidacy: attempt each selected form independently.
#Exactly one clean parse -> auto-selected. None -> a noformmatch error naming each
#candidate form's failure (ranked best-candidate first - see rank_form_failures).
#Several -> a multipleformmatches error: no silent preference between matching
#forms - callers with an intended form pass -form (decision recorded in G-041).
set matched [list]
set matchresult ""
set formfailures [dict create]
foreach fid $selected_forms {
if {[catch {private::get_dict_form $argspecs $fid $rawargs} fresult ropts]} {
set ecode [Dict_getdef $ropts -errorcode ""]
if {[lrange $ecode 0 1] ne [list PUNKARGS VALIDATION]} {
#not a per-form validation outcome (e.g definition error) - propagate
return -options $ropts $fresult
}
set classinfo [lindex $ecode 2]
set failureclass [lindex $classinfo 0]
dict set formfailures $fid [dict create\
status [private::parse_status_classify $failureclass [lrange $classinfo 1 end]]\
failureclass $failureclass\
badarg [Dict_getdef [lrange $ecode 3 end] -badarg ""]\
message [lindex [split $fresult \n] 0]\
]
} else {
lappend matched $fid
if {[llength $matched] == 1} {
set matchresult $fresult
}
} }
set selected_forms [list [lindex $form_names $opt_form]] }
} else { switch -- [llength $matched] {
set fmatch [tcl::prefix::match -error "" $form_names $opt_form] 1 {
if {$fmatch eq ""} { #auto-selected - report every candidate's status alongside the result
error "punk::args::get_dict invalid -form value '$opt_form' Expected int 0-[expr {[llength $form_names]-1}] or one of '$form_names'" #(partial-arglist consumers e.g command completion want per-form
#compatibility, not only the winner - see G-044)
set formstatus [dict create]
foreach fid $selected_forms {
if {$fid eq [lindex $matched 0]} {
dict set formstatus $fid [dict create status valid]
} else {
dict set formstatus $fid [dict get $formfailures $fid]
}
}
dict set matchresult formstatus $formstatus
return $matchresult
}
0 {
set formfailures [private::rank_form_failures $argspecs $rawargs $formfailures]
set candidate_fids [dict keys $formfailures]
set classes [lmap finfo [dict values $formfailures] {dict get $finfo status}]
set msg "Bad arguments for %caller%. No form of the command matches the supplied arguments. Candidate forms: $candidate_fids"
dict for {fid finfo} $formfailures {
append msg \n " form '$fid': [dict get $finfo message]"
}
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list noformmatch forms $candidate_fids classes $classes] -argspecs $argspecs -formerrors $formfailures]] $msg
}
default {
set msg "Ambiguous arguments for %caller%. The supplied arguments match more than one form: [join $matched {, }]. Use -form to select the intended form."
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list multipleformmatches forms $matched] -argspecs $argspecs]] $msg
} }
set selected_forms [list $fmatch]
} }
}
#parse rawargs against a single form of a resolved definition - the raising engine
#body, extracted verbatim from get_dict when multi-form candidacy landed (G-041).
#argspecs is a RESOLVED spec dict (get_dict resolves the deflist in its caller's
#context before selecting forms - nothing here touches the caller's frame).
proc private::get_dict_form {argspecs fid rawargs} {
#puts "-arg_info->$arg_info" #puts "-arg_info->$arg_info"
set flagsreceived [list] ;#for checking if required flags satisfied set flagsreceived [list] ;#for checking if required flags satisfied
set solosreceived [list] set solosreceived [list]
@ -9637,9 +9894,7 @@ tcl::namespace::eval punk::args {
# Handle leading positionals # Handle leading positionals
# todo - consider allowing last leading positional to have -multiple 1 but only if there exists an eopts marker later (--) ? # todo - consider allowing last leading positional to have -multiple 1 but only if there exists an eopts marker later (--) ?
#todo - handle multiple fids? set formdict [dict get $argspecs FORMS $fid]
set fid [lindex $selected_forms 0]
set formdict [dict get $FORMS $fid]
# formdict keys: argspace ARG_INFO ARG_CHECKS LEADER_DEFAULTS LEADER_REQUIRED # formdict keys: argspace ARG_INFO ARG_CHECKS LEADER_DEFAULTS LEADER_REQUIRED
# LEADER_NAMES LEADER_MIN LEADER_MAX LEADER_TAKEWHENARGSMODULO LEADER_UNNAMED # LEADER_NAMES LEADER_MIN LEADER_MAX LEADER_TAKEWHENARGSMODULO LEADER_UNNAMED
# LEADERSPEC_DEFAULTS LEADER_CHECKS_DEFAULTS OPT_DEFAULTS OPT_REQUIRED OPT_NAMES # LEADERSPEC_DEFAULTS LEADER_CHECKS_DEFAULTS OPT_DEFAULTS OPT_REQUIRED OPT_NAMES
@ -9889,7 +10144,7 @@ tcl::namespace::eval punk::args {
incr tentative_idx incr tentative_idx
} }
} }
set assign_d [private::get_dict_can_assign_value 0 $tentative_pre_values 0 [list $leader_posn_name] $leadernames_seen $formdict] set assign_d [get_dict_can_assign_value 0 $tentative_pre_values 0 [list $leader_posn_name] $leadernames_seen $formdict]
set consumed [dict get $assign_d consumed] set consumed [dict get $assign_d consumed]
set resultlist [dict get $assign_d resultlist] set resultlist [dict get $assign_d resultlist]
set newtypelist [dict get $assign_d typelist] set newtypelist [dict get $assign_d typelist]
@ -10830,7 +11085,7 @@ tcl::namespace::eval punk::args {
set leadertypelist [tcl::dict::get $argstate $leadername -type] ;#often a single type, but can be a list of types (possibly with some optional) for a type that is a clause accepting multiple values. set leadertypelist [tcl::dict::get $argstate $leadername -type] ;#often a single type, but can be a list of types (possibly with some optional) for a type that is a clause accepting multiple values.
set leader_clause_size [llength $leadertypelist] set leader_clause_size [llength $leadertypelist]
set assign_d [private::get_dict_can_assign_value $ldridx $leaders $nameidx $LEADER_NAMES $leadernames_received $formdict] set assign_d [get_dict_can_assign_value $ldridx $leaders $nameidx $LEADER_NAMES $leadernames_received $formdict]
set consumed [dict get $assign_d consumed] set consumed [dict get $assign_d consumed]
set resultlist [dict get $assign_d resultlist] set resultlist [dict get $assign_d resultlist]
set newtypelist [dict get $assign_d typelist] set newtypelist [dict get $assign_d typelist]
@ -11041,7 +11296,7 @@ tcl::namespace::eval punk::args {
set valtypelist [tcl::dict::get $argstate $valname -type] set valtypelist [tcl::dict::get $argstate $valname -type]
set clause_size [llength $valtypelist] ;#common case is clause_size == 1 set clause_size [llength $valtypelist] ;#common case is clause_size == 1
set assign_d [private::get_dict_can_assign_value $validx $values $nameidx $VAL_NAMES $valnames_received $formdict] set assign_d [get_dict_can_assign_value $validx $values $nameidx $VAL_NAMES $valnames_received $formdict]
set consumed [dict get $assign_d consumed] ;#count set consumed [dict get $assign_d consumed] ;#count
set resultlist [dict get $assign_d resultlist] set resultlist [dict get $assign_d resultlist]
set newtypelist [dict get $assign_d typelist] set newtypelist [dict get $assign_d typelist]
@ -11792,7 +12047,7 @@ tcl::namespace::eval punk::args {
#todo - handle type-alternates e.g -type char|double #todo - handle type-alternates e.g -type char|double
#------------------------------------------------------------------------------------ #------------------------------------------------------------------------------------
#private::check_clausecolumn argname argclass thisarg thisarg_checks column default_type_expression list_of_clauses list_of_clauses_check list_of_clauses_typelist #private::check_clausecolumn argname argclass thisarg thisarg_checks column default_type_expression list_of_clauses list_of_clauses_check list_of_clauses_typelist
private::check_clausecolumn $argname $argclass $thisarg $thisarg_checks $clausecolumn $type_expression $vlist $vlist_check $vlist_typelist $argspecs check_clausecolumn $argname $argclass $thisarg $thisarg_checks $clausecolumn $type_expression $vlist $vlist_check $vlist_typelist $argspecs
#------------------------------------------------------------------------------------ #------------------------------------------------------------------------------------
@ -11846,7 +12101,10 @@ tcl::namespace::eval punk::args {
} }
} }
set docid [dict get $argspecs id] set docid [dict get $argspecs id]
return [tcl::dict::create leaders $leaders_dict opts $finalopts values $values_dict received $received_posns solos $solosreceived multis $multisreceived id $docid] #G-041: form records the parsed form (auto-selected for multiform definitions).
#Positional consumers (lassign [dict values ...]) rely on the first keys - new
#keys are appended after id.
return [tcl::dict::create leaders $leaders_dict opts $finalopts values $values_dict received $received_posns solos $solosreceived multis $multisreceived id $docid form $fid]
} }
lappend PUNKARGS [list { lappend PUNKARGS [list {

3
src/modules/punk/args-buildversion.txt

@ -1,6 +1,7 @@
0.9.0 0.10.0
#First line must be a semantic version number #First line must be a semantic version number
#all other lines are ignored. #all other lines are ignored.
#0.10.0 - G-041 multi-form candidacy: punk::args::parse/get_dict with the default -form * (or any multi-form selection) now attempts every permitted form instead of effectively parsing form 0 only - a clean match against exactly one form is auto-selected, no match raises a 'noformmatch' PUNKARGS VALIDATION error naming each candidate form's first-line failure (candidates ranked best-first: leading-literal affinity with the supplied words, then incomplete before invalid, then declaration order - private::form_selection/form_literal_affinity/rank_form_failures), and several clean matches raise 'multipleformmatches' naming the forms (no silent preference - deliberate, callers pass -form to disambiguate). -form now accepts a list of form names/indices as documented (get_dict, parse, parse_status, arg_error; supplied order preserved - arg_error renders the argument table for the first listed form and marks all listed forms' synopsis entries; parse's error render passes the ranked candidates). Parse results gain a 'form' key (the parsed form; keys appended after 'id' - positional consumers unaffected) and, when candidacy ran, a 'formstatus' key reporting every attempted form's outcome; parse_status 'form' is now the matched/best-candidate form (per-argument statuses and badarg marking built for it) and gains the documented 'formstatus' key (per-form status/failureclass/badarg/message with caller attribution) - the per-form compatibility surface the G-044 completion/hinting consumer needs. Engine body extracted verbatim to private::get_dict_form (single-form parse; argspecs resolved before selection - no caller-frame use). forms.test GAP pins flipped (auto-selection, -form list restriction) + new coverage (shared-prologue arity discrimination, noformmatch ranking/errorcode, multipleformmatches, formstatus in results and parse_status).
#0.9.0 - G-071: allocation choice screen - get_dict_can_assign_value no longer blanket-accepts any word for an argument with a RESTRICTED choice set; where allocation has an alternative (the argument is -optional, or a further occurrence of a -multiple argument) the candidate word is screened with choiceword_match (the shared G-040 implementation: exact/alias/prefix/nocase semantics; -choicemultiple words screened per list member within min/max), and a non-matching word yields onward to later elements/clauses instead of being consumed and failing validation. Fixes the lseq-class in-form failures: an optional choice noise word between required values plus a trailing optional-member clause ('lseq 0 10 2', '0 10 by 2', '1 5 by 0' now parse; noise-word variants and prefix normalization unchanged; genuinely invalid arglists now get the plain excess-values rejection instead of blaming the unrelated optional). REQUIRED arguments are deliberately not screened - the word must fill them and validation's choiceviolation reporting stays informative. -choicerestricted 0 behaviour unchanged. allocation.test GAPs flipped; parse_status -form documented-order behaviour pinned (a prior mis-premise: -form was already supported before the withid/withdef tail per its synopsis). #0.9.0 - G-071: allocation choice screen - get_dict_can_assign_value no longer blanket-accepts any word for an argument with a RESTRICTED choice set; where allocation has an alternative (the argument is -optional, or a further occurrence of a -multiple argument) the candidate word is screened with choiceword_match (the shared G-040 implementation: exact/alias/prefix/nocase semantics; -choicemultiple words screened per list member within min/max), and a non-matching word yields onward to later elements/clauses instead of being consumed and failing validation. Fixes the lseq-class in-form failures: an optional choice noise word between required values plus a trailing optional-member clause ('lseq 0 10 2', '0 10 by 2', '1 5 by 0' now parse; noise-word variants and prefix normalization unchanged; genuinely invalid arglists now get the plain excess-values rejection instead of blaming the unrelated optional). REQUIRED arguments are deliberately not screened - the word must fill them and validation's choiceviolation reporting stays informative. -choicerestricted 0 behaviour unchanged. allocation.test GAPs flipped; parse_status -form documented-order behaviour pinned (a prior mis-premise: -form was already supported before the withid/withdef tail per its synopsis).
#0.8.3 - G-071: silenced four more unconditional debug puts on get_dict's allocation retreat paths ("get_dict cannot assign val:... (111)/(222)/(333)/(444)") - these fired on stderr during NORMAL successful parses whenever an optional element's candidate word was rejected and allocation retreated (e.g. every noise-word skip when parsing if/lseq-modelled commands), polluting interactive output. Same class as the 0.2.3/0.8.2 finds. The retreat logic they marked is the target of the G-071 allocator-correctness work; behaviour unchanged, output only. New allocation.test characterization suite (reduced lseq-range/if-shape fixtures): current mis-allocation and misblame pinned as GAP tests (flip with G-071), noise-word variants and if-shape guards pinned as regression guards, parse_status -form absence pinned as GAP. #0.8.3 - G-071: silenced four more unconditional debug puts on get_dict's allocation retreat paths ("get_dict cannot assign val:... (111)/(222)/(333)/(444)") - these fired on stderr during NORMAL successful parses whenever an optional element's candidate word was rejected and allocation retreated (e.g. every noise-word skip when parsing if/lseq-modelled commands), polluting interactive output. Same class as the 0.2.3/0.8.2 finds. The retreat logic they marked is the target of the G-071 allocator-correctness work; behaviour unchanged, output only. New allocation.test characterization suite (reduced lseq-range/if-shape fixtures): current mis-allocation and misblame pinned as GAP tests (flip with G-071), noise-word variants and if-shape guards pinned as regression guards, parse_status -form absence pinned as GAP.
#0.8.2 - fixed stray debug output: an unconditional 'puts' in private::get_dict_can_assign_value ("checking tp '<type>' against value '<value>'") fired on multi-element clause type checks (e.g. parsing 'try ... trap ... on ...' style arglists against the tclcore moduledoc), polluting interactive output - now commented like its 0.2.3 companion. Found during G-041 prework probing (real-vs-model divergence sweep of if/switch/try/lseq). #0.8.2 - fixed stray debug output: an unconditional 'puts' in private::get_dict_can_assign_value ("checking tp '<type>' against value '<value>'") fired on multi-element clause type checks (e.g. parsing 'try ... trap ... on ...' style arglists against the tclcore moduledoc), polluting interactive output - now commented like its 0.2.3 companion. Found during G-041 prework probing (real-vs-model divergence sweep of if/switch/try/lseq).

165
src/tests/modules/punk/args/testsuites/args/forms.test

@ -6,13 +6,14 @@ package require punk::ns
#Multi-form definition (@form directive) characterization - added 2026-07-08 ahead of G-041 #Multi-form definition (@form directive) characterization - added 2026-07-08 ahead of G-041
#(punk::args multi-form matching: automated form selection for parsing and documentation). #(punk::args multi-form matching: automated form selection for parsing and documentation).
#Tests marked GAP pin the CURRENT behaviour that G-041 changes: #G-041 implemented 2026-07-13: parse without -form (default *) attempts every permitted
# - punk::args::parse without -form (default *) does not attempt non-zero forms: input #form - a clean match against exactly one form is auto-selected (result 'form' key
# matching only a later form fails with form 0's type/arity error #records it, 'formstatus' reports every candidate), no match raises a noformmatch error
# - -form is documented as accepting a set/list of forms but currently accepts only a #naming each candidate form's failure (ranked best-candidate first), several matches
# single form name or integer index #raise a multipleformmatches error, and -form accepts a list of form names/indices as
#The explicit single -form selections and the synopsis/spec structure tests are expected #documented. The former GAP pins (forms_parse_default_form0_only_GAP,
#to remain valid after G-041. #forms_parse_formlist_rejected_GAP) flipped to forms_parse_autoselect and
#forms_parse_formlist_restriction.
namespace eval ::testspace { namespace eval ::testspace {
namespace import ::tcltest::* namespace import ::tcltest::*
@ -110,39 +111,155 @@ namespace eval ::testspace {
{idle idle scripts {{puts hi}}}\ {idle idle scripts {{puts hi}}}\
] ]
test forms_parse_default_form0_only_GAP {GAP (G-041): without -form, input matching only a later form fails with form 0's error}\ #flipped from forms_parse_default_form0_only_GAP 2026-07-13 (agent, G-041)
test forms_parse_autoselect {without -form, input cleanly matching exactly one form is auto-selected (result form key records it)}\
-setup $common -body { -setup $common -body {
#form 0 input parses fine without -form foreach arglist {
set argd [punk::args::parse {450} withid ::testspace::afterish] {450 {puts hi}}
lappend result [dict get $argd values] {cancel after#1 after#2}
#input matching only the cancel form is NOT auto-selected - fails against form 0 (ms -type int) {idle {puts hi}}
if {[catch {punk::args::parse {cancel after#1} withid ::testspace::afterish} errmsg]} { } {
lappend result [string match "*Bad number of values*" $errmsg] set argd [punk::args::parse $arglist withid ::testspace::afterish]
lappend result [dict get $argd form] [dict get $argd values]
}
set result
}\
-cleanup {
}\
-result [list\
ms {ms 450 script {{puts hi}}}\
cancel {cancel cancel ids {after#1 after#2}}\
idle {idle idle scripts {{puts hi}}}\
]
#added 2026-07-13 (agent, G-041)
test forms_parse_autoselect_shared_prologue {auto-selection distinguishes forms sharing a leader block by their value arity}\
-setup $common -body {
set argd [punk::args::parse {mykey} withid ::testspace::sharedform]
lappend result [dict get $argd form]
set argd [punk::args::parse {mykey myvalue} withid ::testspace::sharedform]
lappend result [dict get $argd form] [dict get $argd values]
}\
-cleanup {
}\
-result [list get set {newvalue myvalue}]
#added 2026-07-13 (agent, G-041)
test forms_parse_autoselect_formstatus {a multi-form auto-selected parse reports every candidate form's status in the result}\
-setup $common -body {
set argd [punk::args::parse {cancel after#1} withid ::testspace::afterish]
set formstatus [dict get $argd formstatus]
lappend result [dict keys $formstatus]
lappend result [dict get $formstatus cancel status]
lappend result [dict get $formstatus ms status]
#single-form parses take the direct path - no formstatus key, form key present
set argd [punk::args::parse {a b} withdef {
@id -id ::testspace::formsingle
x -type string
y -type string
}]
lappend result [dict get $argd form] [dict exists $argd formstatus]
}\
-cleanup {
}\
-result [list {ms cancel idle} valid incomplete _default 0]
#added 2026-07-13 (agent, G-041)
test forms_parse_noformmatch {input matching no form raises an error naming each candidate form's failure - best candidate (literal affinity) first}\
-setup $common -body {
#'cancel' alone: the cancel form is incomplete (ids missing), ms/idle don't fit
if {[catch {punk::args::parse {cancel} -errorstyle minimal withid ::testspace::afterish} errmsg erroropts]} {
set ecode [dict get $erroropts -errorcode]
set classinfo [lindex $ecode 2]
lappend result [lindex $classinfo 0]
#ranked candidates: leading-literal agreement puts the cancel form first
lappend result [lindex [dict get [lrange $classinfo 1 end] forms] 0]
lappend result [string match "*No form of the command matches*" $errmsg]
foreach fname {ms cancel idle} {
lappend result [string match "*form '$fname':*" $errmsg]
}
} else { } else {
lappend result UNEXPECTED-autoselected-cancel-form lappend result UNEXPECTED-parsed
} }
#same for the idle form set result
if {[catch {punk::args::parse {idle {puts hi}} withid ::testspace::afterish}]} { }\
lappend result idle-not-autoselected -cleanup {
}\
-result [list noformmatch cancel 1 1 1 1]
#added 2026-07-13 (agent, G-041)
test forms_parse_multipleformmatches {input cleanly matching several permitted forms raises an error naming them - explicit -form disambiguates}\
-setup $common -body {
punk::args::define {
@id -id ::testspace::ambigform
@cmd -name testspace::ambigform -summary "ambiguous multiform" -help "two forms accepting one string"
@form -form alpha
@values -min 1 -max 1
v1 -type string
@form -form beta
@values -min 1 -max 1
v2 -type string
}
if {[catch {punk::args::parse {hello} -errorstyle minimal withid ::testspace::ambigform} errmsg erroropts]} {
set classinfo [lindex [dict get $erroropts -errorcode] 2]
lappend result [lindex $classinfo 0]
lappend result [dict get [lrange $classinfo 1 end] forms]
} else { } else {
lappend result UNEXPECTED-autoselected-idle-form lappend result UNEXPECTED-parsed
} }
set argd [punk::args::parse {hello} -form beta withid ::testspace::ambigform]
lappend result [dict get $argd form] [dict get $argd values]
}\ }\
-cleanup { -cleanup {
punk::args::undefine ::testspace::ambigform 1
}\ }\
-result [list {ms 450} 1 idle-not-autoselected] -result [list multipleformmatches {alpha beta} beta {v2 hello}]
test forms_parse_formlist_rejected_GAP {GAP (G-041): -form documented as a list of forms but only a single name/index is accepted}\ #flipped from forms_parse_formlist_rejected_GAP 2026-07-13 (agent, G-041)
test forms_parse_formlist_restriction {-form accepts a list of form names/indices and restricts candidacy to that subset}\
-setup $common -body { -setup $common -body {
if {[catch {punk::args::parse {idle {puts hi}} -form {cancel idle} withid ::testspace::afterish} errmsg]} { #auto-selection within the listed subset
set argd [punk::args::parse {idle {puts hi}} -form {cancel idle} withid ::testspace::afterish]
lappend result [dict get $argd form]
#indices work in the list as for single values
set argd [punk::args::parse {cancel after#1} -form {1 2} withid ::testspace::afterish]
lappend result [dict get $argd form]
#input matching only an excluded form is not considered
if {[catch {punk::args::parse {450} -form {cancel idle} -errorstyle minimal withid ::testspace::afterish} errmsg erroropts]} {
set classinfo [lindex [dict get $erroropts -errorcode] 2]
lappend result [lindex $classinfo 0] [lsort [dict get [lrange $classinfo 1 end] forms]]
} else {
lappend result UNEXPECTED-accepted-excluded-form-input
}
#an unrecognised element still errors as for single values
if {[catch {punk::args::parse {450} -form {ms bogusform} withid ::testspace::afterish} errmsg]} {
lappend result [string match "*invalid -form value*" $errmsg] lappend result [string match "*invalid -form value*" $errmsg]
} else { } else {
lappend result UNEXPECTED-accepted-form-list lappend result UNEXPECTED-accepted-bogus-form
} }
}\ }\
-cleanup { -cleanup {
}\ }\
-result [list 1] -result [list idle cancel noformmatch {cancel idle} 1]
#added 2026-07-13 (agent, G-041)
test forms_parsestatus_form_autoselect {parse_status reports the auto-selected form, and for noformmatch the best-candidate form with per-form statuses}\
-setup $common -body {
#valid: form key = the matched form; formstatus covers every candidate
set pstat [punk::args::parse_status {cancel after#1} withid ::testspace::afterish]
lappend result [dict get $pstat ok] [dict get $pstat form]
lappend result [dict get $pstat formstatus cancel status] [dict get $pstat formstatus idle status]
#noformmatch: per-argument statuses are built for the best candidate (cancel)
#and formstatus messages carry caller attribution (%caller% substituted)
set pstat [punk::args::parse_status {cancel} -caller afterish withid ::testspace::afterish]
lappend result [dict get $pstat ok] [dict get $pstat status] [dict get $pstat failureclass]
lappend result [dict get $pstat form]
lappend result [string match "*%caller%*" [dict get $pstat formstatus ms message]]
lappend result [string match "*afterish*" [dict get $pstat formstatus ms message]]
}\
-cleanup {
}\
-result [list 1 cancel valid incomplete 0 incomplete noformmatch cancel 0 1]
test forms_synopsis_lists_all_forms {punk::ns::synopsis renders a synopsis line per form}\ test forms_synopsis_lists_all_forms {punk::ns::synopsis renders a synopsis line per form}\
-setup $common -body { -setup $common -body {

Loading…
Cancel
Save