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] |
[project] |
||||||
name = "punkshell" |
name = "punkshell" |
||||||
version = "0.12.21" |
version = "0.12.22" |
||||||
license = "BSD-2-Clause" |
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