Browse Source
New punk::args::formcheck <id> ?-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 <formname-list> 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 <id-shaped>' 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.commaster
11 changed files with 774 additions and 11 deletions
@ -1,4 +1,4 @@
|
||||
[project] |
||||
name = "punkshell" |
||||
version = "0.12.21" |
||||
version = "0.12.22" |
||||
license = "BSD-2-Clause" |
||||
|
||||
@ -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 <id-shaped>' 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. |
||||
Loading…
Reference in new issue