Browse Source
tool/buildsuite/help are multi-form punk::args definitions (one @form per action, literal single-choice action leaders + choicelabels): 'help tool' / 'help buildsuite' render one synopsis line per action; 'make.tcl help <subcommand> <action>' - equivalently '<subcommand> <action> -help', or a 0-based form index ('help tool 2') - renders that action's single-form usage; unknown actions and out-of-range indexes are pointed punk::args errors (exit 1). tool dispatch parses through the definition (unknown actions/flags: exit-1 usage errors). User-approved deviation: the declared positional model puts options before tool names ('tool build -test 0 <name> ...'); docs/agent guidance updated to match and a flag-shaped tool name earns a stderr hint; the PUNKBOOT_PLAIN degraded scan keeps the historic flag-anywhere parse. buildsuite driver-arg passthrough unchanged. G-144 consumer follow-through: all 17 per-subcommand @form -synopsis overrides retired (automatic @cmd -name bracket-notation synopses; top-level make.tcl override kept deliberately). Pinned by new punkexe/maketclhelp.test (12 tests); full punkexe subtree green (114 tests, 0 fail). Goal flipped to achieved and archived; punkshell 0.40.0. Assisted-by: harness=claude; primary-model=claude-opus-5[1m]; api-location=anthropic.commaster
9 changed files with 533 additions and 77 deletions
@ -0,0 +1,303 @@
|
||||
package require tcltest |
||||
|
||||
#Piped characterization of make.tcl's help depth (goal G-143): the tool and |
||||
#buildsuite subcommands are declared multi-form (one @form per action with a |
||||
#single-choice action leader + -choicelabels), so full-subcommand help renders |
||||
#one synopsis line per action, 'make.tcl help <subcommand> <action>' (and |
||||
#'<subcommand> <action> -help') renders that action's single-form usage, tool |
||||
#dispatch parses through the definition (pointed punk::args usage errors, |
||||
#exit 1, for unknown actions and option-position unknown flags), and buildsuite |
||||
#keeps its passthrough driver-args contract (forms serve help/synopsis only). |
||||
#Pins: |
||||
# - 'help tool' / 'help buildsuite': per-action synopsis lines with i -form hints |
||||
# and the action -choicelabels in the choices area; ESC-free (G-113 piped policy) |
||||
# - 'help tool build' / 'help buildsuite build': the form's own argument table |
||||
# (-test opt + toolname; suitename + driverarg) |
||||
# - 'help tool 2' (0-based form index - the notation of the rendered ' i -form N ' |
||||
# hints and of punk::args's own -form error text): same render as 'help tool |
||||
# build'; an out-of-range index exits 1 with the punk::args -form error |
||||
# - 'help tool frobnicate' / 'help buildsuite frobnicate': exit 1 with a pointed |
||||
# punk::args -form error naming the allowed forms |
||||
# - 'tool build -help': the <subcommand> <action> -help route renders the form |
||||
# - 'tool frobnicate' / 'tool build -bogus punkzip': exit 1 punk::args usage errors |
||||
# - 'tool build punkzip -test 0': exit 2 with the misplaced-flag guidance (options |
||||
# precede tool names in the definition's positional model - the historic |
||||
# flag-anywhere order is deliberately not carried over) |
||||
# - 'buildsuite build suite_tcl90 -bogusxyz': the arbitrary flag reaches the |
||||
# driver untouched (the driver's own unknown-option error, not a usage error) |
||||
# - PUNKBOOT_PLAIN=1 degrade: same invocations handled by the plain scan (tool |
||||
# list exit 0; tool frobnicate keeps the historic exit-2 surface; plain help |
||||
# text carries the per-action lines) |
||||
#Driven through PLAIN tclsh (the acceptance's named invocation |
||||
#'tclsh src/make.tcl help ...'): the working tree's make.tcl + bootsupport |
||||
#punk::args are exercised directly. Kit-hosted rendering ('<punkexe> script |
||||
#src/make.tcl help tool') shows the raw (script) ids until the next routine |
||||
#vfscommonupdate+bake refreshes the kit's preloaded punk::args past 0.13.0 |
||||
#(the documented punk-exe-hosted provenance-mixing hazard; the G-144 (script) |
||||
#name fallback is 0.13.0-era). The kit-hosted dispatch surfaces that do not |
||||
#depend on name rendering are pinned in maketcltool.test. |
||||
# |
||||
#Resolved lazily in the test body. Skipped (constraint tclshavailable) if no |
||||
#tclsh is on PATH. |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
variable testdir [file dirname [file normalize [info script]]] |
||||
#<projectroot>/src/tests/shell/testsuites/punkexe -> 5 levels up to <projectroot> |
||||
variable projectroot [file normalize [file join $testdir .. .. .. .. ..]] |
||||
variable maketcl [file join $projectroot src make.tcl] |
||||
|
||||
testConstraint tclshavailable [expr {[auto_execok tclsh] ne ""}] |
||||
|
||||
variable maketcl_run_timeout_ms 60000 |
||||
|
||||
variable runstate |
||||
array set runstate {} |
||||
|
||||
proc maketcl_run_read {chan} { |
||||
variable runstate |
||||
append runstate(output) [read $chan] |
||||
if {[chan eof $chan]} { |
||||
chan event $chan readable {} |
||||
set runstate(done) eof |
||||
} |
||||
} |
||||
|
||||
#Run 'tclsh src/make.tcl <subcommand...>' with output captured through a pipe |
||||
#(stdin half-closed for immediate EOF - make.tcl must never wait on stdin for |
||||
#these invocations). envoverrides is a dict: name value pairs applied to ::env |
||||
#for the child (a value of "" means unset). Saved values are restored after |
||||
#the run. Returns dict: timedout 0|1, exitcode <int|"">, output <combined |
||||
#stdout+stderr>. |
||||
proc maketcl_run {cmdargs {envoverrides {}}} { |
||||
variable runstate |
||||
variable maketcl_run_timeout_ms |
||||
variable maketcl |
||||
array unset runstate |
||||
set runstate(output) "" |
||||
set runstate(done) "" |
||||
|
||||
set saved [dict create] |
||||
dict for {evar eval_} $envoverrides { |
||||
if {[info exists ::env($evar)]} { |
||||
dict set saved $evar [list 1 $::env($evar)] |
||||
} else { |
||||
dict set saved $evar [list 0 {}] |
||||
} |
||||
if {$eval_ eq ""} { |
||||
unset -nocomplain ::env($evar) |
||||
} else { |
||||
set ::env($evar) $eval_ |
||||
} |
||||
} |
||||
try { |
||||
set runcmd [list [auto_execok tclsh] $maketcl {*}$cmdargs 2>@1] |
||||
set chan [open |$runcmd r+] |
||||
chan configure $chan -blocking 0 -translation binary |
||||
catch {chan close $chan write} ;#no stdin for the child - immediate EOF |
||||
set timerid [after $maketcl_run_timeout_ms [list set [namespace current]::runstate(done) timeout]] |
||||
chan event $chan readable [list [namespace current]::maketcl_run_read $chan] |
||||
while {$runstate(done) eq ""} { |
||||
vwait [namespace current]::runstate(done) |
||||
} |
||||
after cancel $timerid |
||||
set timedout [expr {$runstate(done) eq "timeout"}] |
||||
set exitcode "" |
||||
if {$timedout} { |
||||
catch {exec {*}[auto_execok taskkill] /F /T /PID [lindex [pid $chan] 0]} |
||||
catch {chan close $chan} |
||||
} else { |
||||
chan configure $chan -blocking 1 |
||||
if {[catch {chan close $chan} errdata errdict]} { |
||||
set exitcode [lindex [dict get $errdict -errorcode] end] |
||||
} else { |
||||
set exitcode 0 |
||||
} |
||||
} |
||||
return [dict create timedout $timedout exitcode $exitcode output $runstate(output)] |
||||
} finally { |
||||
dict for {evar restore} $saved { |
||||
lassign $restore existed oldval |
||||
if {$existed} { |
||||
set ::env($evar) $oldval |
||||
} else { |
||||
unset -nocomplain ::env($evar) |
||||
} |
||||
} |
||||
} |
||||
} |
||||
|
||||
proc esc_count {text} { |
||||
return [regexp -all {\x1b} $text] |
||||
} |
||||
|
||||
#added 2026-08-01 (agent, G-143) |
||||
test maketcl_help_tool_multiform {piped 'make.tcl help tool': exit 0, ESC-free, one synopsis line per action with i -form hints and the action choicelabel} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {help tool}] |
||||
set out [dict get $r output] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result esc [esc_count $out] |
||||
lappend result synlist [regexp {make\.tcl tool list \[toolname\]\.\.\.} $out] |
||||
lappend result syninfo [regexp {make\.tcl tool info toolname \[toolname\]\.\.\.} $out] |
||||
lappend result synbuild [regexp {make\.tcl tool build \[-test <bool>\] \[toolname\]\.\.\.} $out] |
||||
lappend result syntest [regexp {make\.tcl tool test \[toolname\]\.\.\.} $out] |
||||
lappend result formhints [regexp { i -form 0 } $out] |
||||
lappend result choicelabel [regexp {Discover the tools with version, zig floor, install state} $out] |
||||
set result |
||||
} -result {timedout 0 exitcode 0 esc 0 synlist 1 syninfo 1 synbuild 1 syntest 1 formhints 1 choicelabel 1} |
||||
|
||||
#added 2026-08-01 (agent, G-143) |
||||
test maketcl_help_tool_build_form {'make.tcl help tool build' renders the build form's argument table (-test opt, toolname, build choicelabel)} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {help tool build}] |
||||
set out [dict get $r output] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result esc [esc_count $out] |
||||
lappend result testopt [regexp {\?-test\?} $out] |
||||
lappend result toolname [regexp {\?toolname\.\.\.\?} $out] |
||||
lappend result choicelabel [regexp {Resolve zig, run the test gate, build ReleaseSafe and install} $out] |
||||
set result |
||||
} -result {timedout 0 exitcode 0 esc 0 testopt 1 toolname 1 choicelabel 1} |
||||
|
||||
#added 2026-08-01 (agent, G-143) - numeric parity with the ' i -form N ...' synopsis |
||||
#hints and punk::args's own -form error notation ('Allowed values 0-N') |
||||
test maketcl_help_form_index {'make.tcl help tool 2' (0-based form index) renders exactly the build form; out-of-range exits 1 with the punk::args -form error} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {help tool 2}] |
||||
set rword [maketcl_run {help tool build}] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result sameasbuildword [expr {[dict get $r output] eq [dict get $rword output]}] |
||||
set r2 [maketcl_run {help tool 9}] |
||||
set out2 [dict get $r2 output] |
||||
lappend result timedout2 [dict get $r2 timedout] exitcode2 [dict get $r2 exitcode] |
||||
lappend result formerr2 [regexp {invalid value for option -form} $out2] |
||||
lappend result range2 [regexp {Allowed values 0-3} $out2] |
||||
set result |
||||
} -result {timedout 0 exitcode 0 sameasbuildword 1 timedout2 0 exitcode2 1 formerr2 1 range2 1} |
||||
|
||||
#added 2026-08-01 (agent, G-143) |
||||
test maketcl_help_buildsuite_multiform {piped 'make.tcl help buildsuite': exit 0, one synopsis line per action} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {help buildsuite}] |
||||
set out [dict get $r output] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result esc [esc_count $out] |
||||
lappend result synlist [regexp {make\.tcl buildsuite list} $out] |
||||
lappend result syninfo [regexp {make\.tcl buildsuite info suitename} $out] |
||||
lappend result synbuild [regexp {make\.tcl buildsuite build suitename \[driverarg\]\.\.\.} $out] |
||||
set result |
||||
} -result {timedout 0 exitcode 0 esc 0 synlist 1 syninfo 1 synbuild 1} |
||||
|
||||
#added 2026-08-01 (agent, G-143) |
||||
test maketcl_help_buildsuite_build_form {'make.tcl help buildsuite build' renders the build form's argument table (suitename + driverarg)} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {help buildsuite build}] |
||||
set out [dict get $r output] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result suitename [regexp {Suite to build\.} $out] |
||||
lappend result driverarg [regexp {\?driverarg\.\.\.\?} $out] |
||||
lappend result fwdnote [regexp {Driver arguments forwarded to suite\.tcl untouched} $out] |
||||
set result |
||||
} -result {timedout 0 exitcode 0 suitename 1 driverarg 1 fwdnote 1} |
||||
|
||||
#added 2026-08-01 (agent, G-143) |
||||
test maketcl_help_unknown_action {'make.tcl help <subcommand> <unknown-action>' exits 1 with a pointed punk::args -form error naming the allowed forms} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {help tool frobnicate}] |
||||
set out [dict get $r output] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result formerr [regexp {invalid value for option -form} $out] |
||||
lappend result named [regexp {Received 'frobnicate'} $out] |
||||
lappend result allowed [regexp {one of 'list info build test'} $out] |
||||
set r2 [maketcl_run {help buildsuite frobnicate}] |
||||
set out2 [dict get $r2 output] |
||||
lappend result timedout2 [dict get $r2 timedout] exitcode2 [dict get $r2 exitcode] |
||||
lappend result formerr2 [regexp {invalid value for option -form} $out2] |
||||
lappend result allowed2 [regexp {one of 'list info build'} $out2] |
||||
set result |
||||
} -result {timedout 0 exitcode 1 formerr 1 named 1 allowed 1 timedout2 0 exitcode2 1 formerr2 1 allowed2 1} |
||||
|
||||
#added 2026-08-01 (agent, G-143) |
||||
test maketcl_tool_subaction_help_route {'make.tcl tool build -help' renders the build form's usage (the <subcommand> <action> -help route)} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {tool build -help}] |
||||
set out [dict get $r output] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result synbuild [regexp {make\.tcl tool build \[-test <bool>\] \[toolname\]\.\.\.} $out] |
||||
lappend result testopt [regexp {\?-test\?} $out] |
||||
set result |
||||
} -result {timedout 0 exitcode 0 synbuild 1 testopt 1} |
||||
|
||||
#added 2026-08-01 (agent, G-143) |
||||
test maketcl_help_toplevel_unchanged {bare 'make.tcl help' still renders the top-level subcommand table} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {help}] |
||||
set out [dict get $r output] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result esc [esc_count $out] |
||||
lappend result subcmd [regexp {subcommand} $out] |
||||
lappend result bakehouse [regexp {bakehouse} $out] |
||||
lappend result toolrow [regexp {tool} $out] |
||||
set result |
||||
} -result {timedout 0 exitcode 0 esc 0 subcmd 1 bakehouse 1 toolrow 1} |
||||
|
||||
#added 2026-08-01 (agent, G-143) |
||||
test maketcl_tool_dispatch_usage_errors {'make.tcl tool <unknown-action>' and an option-position unknown flag produce pointed punk::args usage errors (exit 1)} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {tool frobnicate}] |
||||
set out [dict get $r output] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result noform [regexp {No form of the command matches the supplied arguments} $out] |
||||
set r2 [maketcl_run {tool build -bogus punkzip}] |
||||
set out2 [dict get $r2 output] |
||||
lappend result timedout2 [dict get $r2 timedout] exitcode2 [dict get $r2 exitcode] |
||||
lappend result noform2 [regexp {No form of the command matches the supplied arguments} $out2] |
||||
set result |
||||
} -result {timedout 0 exitcode 1 noform 1 timedout2 0 exitcode2 1 noform2 1} |
||||
|
||||
#added 2026-08-01 (agent, G-143) |
||||
test maketcl_tool_misplaced_flag_hint {'tool build punkzip -test 0' (historic flag-anywhere order) exits 2 with the options-precede-names guidance} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {tool build punkzip -test 0}] |
||||
set out [dict get $r output] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result hint [regexp {looks like a flag - options precede the tool names} $out] |
||||
lappend result notfound [regexp {tool '-test' not found under} $out] |
||||
set result |
||||
} -result {timedout 0 exitcode 2 hint 1 notfound 1} |
||||
|
||||
#added 2026-08-01 (agent, G-143) |
||||
test maketcl_buildsuite_driver_forwarding {'buildsuite build <suite> <arbitrary-flag>' forwards the flag to the driver untouched (the driver's own unknown-option error, not a punk::args usage error)} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {buildsuite build suite_tcl90 -bogusxyz}] |
||||
set out [dict get $r output] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result fwdline [regexp {with forwarded args: -bogusxyz} $out] |
||||
lappend result drivererr [regexp {suite_tcl90 ERROR: unknown option '-bogusxyz'} $out] |
||||
lappend result nousageerr [regexp {No form of the command matches} $out] |
||||
set result |
||||
} -result {timedout 0 exitcode 1 fwdline 1 drivererr 1 nousageerr 0} |
||||
|
||||
#added 2026-08-01 (agent, G-143) |
||||
test maketcl_plain_degrade {PUNKBOOT_PLAIN=1 degraded dispatch handles the same invocations via the plain scan (tool list exit 0; unknown action keeps the historic exit-2 surface; plain help carries the per-action lines)} -constraints {tclshavailable} -body { |
||||
set r [maketcl_run {tool list} {PUNKBOOT_PLAIN 1}] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result header [regexp {name\s+version\s+zig-floor} [dict get $r output]] |
||||
set r2 [maketcl_run {tool frobnicate} {PUNKBOOT_PLAIN 1}] |
||||
set out2 [dict get $r2 output] |
||||
lappend result timedout2 [dict get $r2 timedout] exitcode2 [dict get $r2 exitcode] |
||||
lappend result historic [regexp {unknown tool action 'frobnicate' - expected list\|info\|build\|test} $out2] |
||||
set r3 [maketcl_run {help tool} {PUNKBOOT_PLAIN 1}] |
||||
set out3 [dict get $r3 output] |
||||
lappend result timedout3 [dict get $r3 timedout] exitcode3 [dict get $r3 exitcode] |
||||
lappend result plainlist [regexp {make\.tcl tool list \?<toolname> \.\.\.\?} $out3] |
||||
lappend result plainbuild [regexp {make\.tcl tool build \?-test 0\|1\? \?<toolname> \.\.\.\?} $out3] |
||||
set result |
||||
} -result {timedout 0 exitcode 0 header 1 timedout2 0 exitcode2 2 historic 1 timedout3 0 exitcode3 0 plainlist 1 plainbuild 1} |
||||
|
||||
cleanupTests |
||||
} |
||||
namespace delete ::testspace |
||||
Loading…
Reference in new issue