From 83b7e2a0dee9c34dd3d2f25697242a12bda1c560 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Fri, 10 Jul 2026 04:15:27 +1000 Subject: [PATCH] punk::ns 0.1.3: usage-marking characterization tests (usagemarking.test, cmdhelp.test) + cmdhelp subcommand doc fix - punk::args level (usagemarking.test, 14 tests): pins -parsedargs/-badarg/-scheme marking primitives, goodchoice highlighting of selected and default-in-effect choice words, and scheme border selection - asserted by SGR-parameter subset against the live colour arrays. GAP pins for the documented -scheme choice 'nocolour' falling through to 'na' (renders with the previous scheme's leftover colours) and the dash-spelling '-nocolour' leaking strike-only goodarg into the shared colour array (G-049 candidates). - punk::ns level (cmdhelp.test, 19 tests): pins scheme selection (error scheme on failed parse of supplied args, info scheme + goodarg marking on success), badarg marking via choiceviolation, the early alias-resolution branch, -return string parity, goodchoice highlighting through cmdhelp, and the cmdinfo result shape. GAP pins: pseudo-command cmdtype 'notfound' despite resolved docid + space-form docid exact-word-only jump (G-051; real 'string is true'/'is tr' pins behind the have_tclcoredocs constraint), TclOO undocumented-method class-summary fallback with info-scheme parse of bogus args (G-052), synopsis marking absence and curried-alias braced-target substitution (G-050), explicit -scheme ignored on the parse-failure path and caller-attribution leaking cmdhelp's internal parse source line at top-level call depth (G-049). - punk::ns 0.1.3 (doc-only): cmdhelp 'subcommand' argument help rewritten - was described as ensemble-subcommands-only; now covers tcl::oo methods and argument words, and documents the info/error scheme display driven by argument validity. - Verified: full punk::args + punk::ns suites green on Tcl 9.0.3 and 8.7. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- src/modules/punk/ns-999999.0a1.0.tm | 11 +- src/modules/punk/ns-buildversion.txt | 3 +- .../args/testsuites/args/usagemarking.test | 432 ++++++++++++++++ .../punk/ns/testsuites/ns/cmdhelp.test | 487 ++++++++++++++++++ 4 files changed, 930 insertions(+), 3 deletions(-) create mode 100644 src/tests/modules/punk/args/testsuites/args/usagemarking.test create mode 100644 src/tests/modules/punk/ns/testsuites/ns/cmdhelp.test diff --git a/src/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index f564f902..2bd39952 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.0.tm @@ -5519,8 +5519,15 @@ y" {return quirkykeyscript} commandpath -optional 1 -help\ "command (may be alias, ensemble, tcl::oo object, tepam proc etc)" subcommand -optional 1 -multiple 1 -default {} -help\ - "subcommand if commandpath is an ensemble. - Multiple subcommands can be supplied if ensembles are further nested" + "Trailing words after commandpath: ensemble subcommands + (multiple words if ensembles are further nested), tcl::oo + object/class methods, or argument words for the resolved + command or subcommand. + Argument words are validated against the command's argument + definition and reflected in the usage display: a complete + valid set renders with the 'info' scheme and the received + arguments marked, an incomplete or invalid set renders with + the 'error' scheme." } proc cmdhelp {args} { set nscaller [uplevel 1 [list ::tcl::namespace::current]] diff --git a/src/modules/punk/ns-buildversion.txt b/src/modules/punk/ns-buildversion.txt index 8d7dbd20..c02867ef 100644 --- a/src/modules/punk/ns-buildversion.txt +++ b/src/modules/punk/ns-buildversion.txt @@ -1,5 +1,6 @@ -0.1.2 +0.1.3 #First line must be a semantic version number #all other lines are ignored. +#0.1.3 - documentation-only: cmdhelp 'subcommand' argument help rewritten to match actual behaviour (was described as ensemble-subcommands-only; also covers tcl::oo methods and argument words, whose validity drives the info/error scheme and received-argument marking of the usage display) #0.1.2 - cmd_traverse subcommand walk resolves choice words via the shared punk::args::choiceword_match resolver (G-040 parity): -choiceprefixdenylist and -choiceprefixreservelist are now honoured in doc lookup (previously ignored - 'i ' could accept words parsing rejects), -choicealiases normalize to their canonical before choiceinfo lookup, and -nocase is honoured in the walk #0.1.1 - commented out five development trace puts in the doc-lookup machinery: "PROC auto def"/"ENSEMBLE auto def" (generate_autodef - emitted on STDOUT, polluting 'i'/'s' output in script/exec contexts), "cmd_traverse - skipping to documented subcommand" (space-form id path), "---> cmd_traverse ensembleparam" (ensemble -parameters traversal), and "cmd_traverse 10 ... - review" (fallthrough return). No functional change. diff --git a/src/tests/modules/punk/args/testsuites/args/usagemarking.test b/src/tests/modules/punk/args/testsuites/args/usagemarking.test new file mode 100644 index 00000000..b9c82031 --- /dev/null +++ b/src/tests/modules/punk/args/testsuites/args/usagemarking.test @@ -0,0 +1,432 @@ +package require tcltest + +package require punk::args +package require punk::ansi + +#Characterization of the parse-status visual marking in punk::args::arg_error - added +#2026-07-10 ahead of G-049 (parse-status data model). The -parsedargs / -badarg / -scheme +#options are the primitives punk::ns::cmdhelp uses to render the good/bad argument +#highlighting seen interactively ('i '), so their behaviour is pinned here +#at the arg_error level before any restructuring. Integration through punk::ns::cmdhelp +#is covered in src/tests/modules/punk/ns/testsuites/ns/cmdhelp.test. +# +#Assertion approach: expected SGR styles are read from the live colour arrays +#(::punk::args::arg_error_CLR and the per-scheme override arrays) rather than hardcoded +#escape strings, and matched by SGR parameter subset (renderers may merge or reorder +#codes) - so the tests pin "the goodarg/badarg style, whatever it is configured as", +#not a specific colour choice. +# +#Scheme discrimination: the info scheme's border (arg_error_CLR_info(ansiborder), currently +#term-grey23) is the only style unique to one scheme - the error scheme's brightyellow bold +#border shares its SGR parameters with the info scheme's title. Tests therefore treat +#"info-border params present" as the info-scheme signature and its absence as error/other. + +namespace eval ::testspace { + namespace import ::tcltest::* + variable common { + set result "" + } + + #SGR colour generation (a+) is gated by punk::console colour state (e.g NO_COLOR env) + #force colour on for deterministic marking output; arg_error's own sentinel reloads + #its colour arrays when the state differs from that at array-build time. + catch {package require punk::console} + if {[info commands ::punk::console::colour] ne ""} { + punk::console::colour on + } + + #--- helpers ---------------------------------------------------------------------------- + #Origin note: punk has canonical implementations of "ANSI in effect at a position" + #(punk::ansi::ansistring INDEXCODE, opunk::Str INDEXCODE) and code splitting/testing + #(punk::ansi::ta, punk::ansi::codetype has_any_effective etc). The minimal SGR-parameter + #helpers below are deliberately kept test-local: this suite verifies punk::args/punk::ns + #RENDERING, and punk::ansi is a dependency of the code under test - verifying its output + #with punk's own higher-level ANSI introspection would leave a shared defect invisible. + #The canonical mechanisms have their own direct coverage in + #src/tests/modules/punk/ansi/testsuites/ansi/ (ansistring.test, ta.test, codetype.test). + + #parameter list of the first SGR sequence in $code e.g \x1b\[32;9m -> {32 9} + proc sgr_params {code} { + if {[regexp {\x1b\[([0-9;]*)m} $code -> params]} { + return [split $params \;] + } + return {} + } + #1 if any single SGR sequence in $text contains every parameter in $params + #and none of the parameters in $withoutparams + proc has_sgr_with {text params {withoutparams {}}} { + if {![llength $params]} { + return 0 + } + foreach {match plist} [regexp -all -inline {\x1b\[([0-9;]*)m} $text] { + set pl [split $plist \;] + set ok 1 + foreach p $params { + if {$p ni $pl} {set ok 0; break} + } + foreach p $withoutparams { + if {$p in $pl} {set ok 0; break} + } + if {$ok} { + return 1 + } + } + return 0 + } + #parameters in $params that are not in $subtractparams + proc lremove_params {params subtractparams} { + set out {} + foreach p $params { + if {$p ni $subtractparams} {lappend out $p} + } + return $out + } + #raw lines of $rendered whose ANSI-stripped content contains $needle + proc lines_with {rendered needle} { + set out {} + foreach ln [split $rendered \n] { + if {[string first $needle [punk::ansi::ansistrip $ln]] >= 0} { + lappend out $ln + } + } + return $out + } + #1 if any line mentioning $needle carries an SGR containing all of $params (and none of $withoutparams) + proc any_line_has_sgr {rendered needle params {withoutparams {}}} { + foreach ln [lines_with $rendered $needle] { + if {[has_sgr_with $ln $params $withoutparams]} { + return 1 + } + } + return 0 + } + + #active-SGR-parameter list per visible character of $ln (SGR codes applied in order; + #a code starting with parameter 0 - or an empty \x1b\[m - resets, other params accumulate) + proc char_sgr_map {ln} { + set map {} + set active {} + set i 0 + set len [string length $ln] + while {$i < $len} { + if {[string index $ln $i] eq "\x1b" && [regexp -start $i {\A\x1b\[([0-9;]*)m} $ln whole params]} { + set plist [split $params \;] + if {![llength $plist]} { + set active {} + } + foreach p $plist { + if {$p eq "" || $p == 0} { + set active {} + } elseif {$p ni $active} { + lappend active $p + } + } + incr i [string length $whole] + } else { + lappend map $active + incr i + } + } + return $map + } + #1 if every character of the first ANSI-stripped occurrence of $word in $ln has $param active + proc word_has_sgr_param {ln word param} { + set plain [punk::ansi::ansistrip $ln] + set start [string first $word $plain] + if {$start < 0} { + return 0 + } + set map [char_sgr_map $ln] + for {set i $start} {$i < $start + [string length $word]} {incr i} { + if {$param ni [lindex $map $i]} {return 0} + } + return 1 + } + #1 if any line of $rendered carries $word with every parameter of $params active across the whole word + proc rendered_word_has_sgr_params {rendered word params} { + if {![llength $params]} { + return 0 + } + foreach ln [lines_with $rendered $word] { + set all 1 + foreach p $params { + if {![word_has_sgr_param $ln $word $p]} {set all 0; break} + } + if {$all} { + return 1 + } + } + return 0 + } + + #--- fixture ---------------------------------------------------------------------------- + + proc markfix {args} {} + punk::args::define { + @id -id ::testspace::markfix + @cmd -name testspace::markfix -summary "markfix summary" -help "markfix help" + @leaders -min 1 -max 1 + lvarname -type string + @opts + -sh|--shape -type string -default square + -flag -type none + @values -min 2 -max 2 + firstval -type int + lastval -type int + } + + proc render_markfix {args} { + punk::args::arg_error "" [punk::args::get_spec ::testspace::markfix] -aserror 0 {*}$args + } + + #choice-bearing fixture for the goodchoice (selected/default choice reverse) highlighting + proc choicefix {args} {} + punk::args::define { + @id -id ::testspace::choicefix + @cmd -name testspace::choicefix -summary "choicefix summary" -help "choicefix help" + @leaders -min 1 -max 1 + animal -choices {cat dog emu} -default dog -optional 1 + @opts + -shade -choices {light dark} -default dark + @values -min 0 -max 1 + volume -type int -optional 1 + } + proc render_choicefix {args} { + punk::args::arg_error "" [punk::args::get_spec ::testspace::choicefix] -aserror 0 {*}$args + } + + #trigger the initial colour-array load, then capture the pristine styles the tests + #assert against (the shared arg_error_CLR array is mutated in place by scheme renders - + #see the leakage GAP pins at the end of this file - so capture before anything else) + render_markfix + variable GOOD [sgr_params $::punk::args::arg_error_CLR(goodarg)] + variable BAD [sgr_params $::punk::args::arg_error_CLR(badarg)] + variable GOODCHOICE [sgr_params $::punk::args::arg_error_CLR(goodchoice)] + variable INFOBORDER [sgr_params $::punk::args::arg_error_CLR_info(ansiborder)] + variable NCGOOD [sgr_params $::punk::args::arg_error_CLR_nocolour(goodarg)] + + #--- -parsedargs goodarg marking -------------------------------------------------------- + + test usagemarking_goodargs_table {received leaders, solo opt and values are goodarg-marked in the table renderer; an unreceived opt is not}\ + -setup $common -body { + variable GOOD + set argd [punk::args::parse {v1 -flag 0 1} withid ::testspace::markfix] + set out [render_markfix -scheme info -parsedargs $argd] + lappend result [any_line_has_sgr $out lvarname $GOOD] + lappend result [any_line_has_sgr $out -flag $GOOD] + lappend result [any_line_has_sgr $out firstval $GOOD] + lappend result [any_line_has_sgr $out lastval $GOOD] + #-sh|--shape was not received - its row must not carry the goodarg style + lappend result [any_line_has_sgr $out shape $GOOD] + }\ + -cleanup { + }\ + -result [list 1 1 1 1 0] + + test usagemarking_goodargs_optalias_folding {an opt received via one alias of an -alias|--fullname optionset marks the optionset's display row}\ + -setup $common -body { + variable GOOD + set argd [punk::args::parse {v1 -sh circle 0 1} withid ::testspace::markfix] + set out [render_markfix -scheme info -parsedargs $argd] + lappend result [any_line_has_sgr $out shape $GOOD] + }\ + -cleanup { + }\ + -result [list 1] + + test usagemarking_goodargs_string_renderer {goodarg marking also applies in the -return string renderer}\ + -setup $common -body { + variable GOOD + set argd [punk::args::parse {v1 0 1} withid ::testspace::markfix] + set out [render_markfix -scheme info -return string -parsedargs $argd] + lappend result [any_line_has_sgr $out lvarname $GOOD] + lappend result [any_line_has_sgr $out firstval $GOOD] + #-flag not received + lappend result [any_line_has_sgr $out -flag $GOOD] + }\ + -cleanup { + }\ + -result [list 1 1 0] + + #--- -badarg marking -------------------------------------------------------------------- + + test usagemarking_badarg_table {-badarg marks exactly the named argument row in the table renderer}\ + -setup $common -body { + variable BAD + set out [render_markfix -badarg firstval] + lappend result [any_line_has_sgr $out firstval $BAD] + lappend result [any_line_has_sgr $out lastval $BAD] + lappend result [any_line_has_sgr $out lvarname $BAD] + }\ + -cleanup { + }\ + -result [list 1 0 0] + + test usagemarking_badarg_string_renderer {-badarg marking also applies in the -return string renderer}\ + -setup $common -body { + variable BAD + set out [render_markfix -return string -badarg firstval] + lappend result [any_line_has_sgr $out firstval $BAD] + lappend result [any_line_has_sgr $out lastval $BAD] + }\ + -cleanup { + }\ + -result [list 1 0] + + test usagemarking_badarg_wins_over_goodarg {when an argument is both received and named as -badarg, the badarg style wins on its row}\ + -setup $common -body { + variable GOOD + variable BAD + set argd [punk::args::parse {v1 0 1} withid ::testspace::markfix] + set out [render_markfix -scheme info -parsedargs $argd -badarg firstval] + lappend result [any_line_has_sgr $out firstval $BAD] + lappend result [any_line_has_sgr $out firstval $GOOD] + #other received args keep goodarg marking + lappend result [any_line_has_sgr $out lvarname $GOOD] + }\ + -cleanup { + }\ + -result [list 1 0 1] + + #--- goodchoice highlighting (selected / default-in-effect choice) ----------------------- + #For arguments with -choices, a successful parse highlights the choice word matching the + #argument's value-in-effect with the goodchoice style (currently reverse video): the + #supplied choice for received arguments, the default choice for arguments the parse + #filled from -default. Applied per choice word (the trie prefix keeps its own style on + #the word's first letter(s)), independent of the row-level goodarg marking. + + test usagemarking_goodchoice_selected_choice {a received choice argument's supplied choice word is goodchoice-highlighted; the other choices are not}\ + -setup $common -body { + variable GOODCHOICE + set argd [punk::args::parse {cat} withid ::testspace::choicefix] + set out [render_choicefix -scheme info -parsedargs $argd] + lappend result [rendered_word_has_sgr_params $out cat $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out dog $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out emu $GOODCHOICE] + }\ + -cleanup { + }\ + -result [list 1 0 0] + + test usagemarking_goodchoice_default_in_effect {an unsupplied choice argument filled from -default gets its default choice word highlighted - without row-level goodarg marking}\ + -setup $common -body { + variable GOODCHOICE + variable GOOD + set argd [punk::args::parse {cat} withid ::testspace::choicefix] + set out [render_choicefix -scheme info -parsedargs $argd] + #-shade was not supplied - its default 'dark' is the value in effect + lappend result [rendered_word_has_sgr_params $out dark $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out light $GOODCHOICE] + #the -shade row itself is not goodarg-marked (not received) + lappend result [any_line_has_sgr $out light $GOOD] + }\ + -cleanup { + }\ + -result [list 1 0 0] + + test usagemarking_goodchoice_requires_parsedargs {without -parsedargs no choice word is highlighted - a -default matching a choice does not highlight on its own}\ + -setup $common -body { + variable GOODCHOICE + set out [render_choicefix] + lappend result [rendered_word_has_sgr_params $out dog $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out dark $GOODCHOICE] + set out [render_choicefix -scheme info] + lappend result [rendered_word_has_sgr_params $out dog $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out dark $GOODCHOICE] + }\ + -cleanup { + }\ + -result [list 0 0 0 0] + + test usagemarking_goodchoice_string_renderer {selected and default-in-effect choice highlighting also applies in the -return string renderer}\ + -setup $common -body { + variable GOODCHOICE + set argd [punk::args::parse {cat} withid ::testspace::choicefix] + set out [render_choicefix -scheme info -return string -parsedargs $argd] + lappend result [rendered_word_has_sgr_params $out cat $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out dog $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out dark $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out light $GOODCHOICE] + }\ + -cleanup { + }\ + -result [list 1 0 1 0] + + #--- scheme selection ------------------------------------------------------------------- + + test usagemarking_scheme_border {-scheme info renders the info border; default and explicit error do not}\ + -setup $common -body { + variable INFOBORDER + set out [render_markfix -scheme info] + lappend result [has_sgr_with $out $INFOBORDER] + #default scheme is error + set out [render_markfix] + lappend result [has_sgr_with $out $INFOBORDER] + set out [render_markfix -scheme error] + lappend result [has_sgr_with $out $INFOBORDER] + }\ + -cleanup { + }\ + -result [list 1 0 0] + + #--- GAP pins: the nocolour scheme and shared colour-array statefulness ------------------ + #arg_error normalizes its -scheme value with a switch whose nocolour arm matches "", + #"-nocolor" and "-nocolour" (leading dash) - so the DOCUMENTED choice value "nocolour" + #falls through to the catch-all "na" scheme: no override array is merged and the render + #uses whatever colours the most recent info/error render left in the shared + #arg_error_CLR array. The dash spelling "-nocolour" does merge the nocolour overrides - + #and because the merge writes the shared array in place, its strike-only goodarg/badarg + #styles then LEAK into all subsequent renders (nothing restores them until a colour + #on/off state flip forces an array reload). + #Pinned 2026-07-10 as characterization - a fix (accept the documented choice value + + #per-render colour resolution, G-049 candidates) should flip these pins. + + test usagemarking_GAP_scheme_nocolour_renders_with_leftover_colours {the documented choice value 'nocolour' is treated as an unknown scheme and renders with the previous scheme's colours}\ + -setup $common -body { + variable INFOBORDER + #prime the shared array with the info scheme, then render 'nocolour' + render_markfix -scheme info + set out [render_markfix -scheme nocolour] + lappend result [has_sgr_with $out $INFOBORDER] + #prime with the error scheme instead - the same call now renders differently + render_markfix -scheme error + set out [render_markfix -scheme nocolour] + lappend result [has_sgr_with $out $INFOBORDER] + }\ + -cleanup { + punk::args::private::argerror_load_colours 1 + }\ + -result [list 1 0] + + test usagemarking_GAP_dash_nocolour_leaks_into_shared_array {a -scheme -nocolour (dash spelling) render overwrites goodarg in the shared colour array}\ + -setup $common -body { + variable GOOD + variable NCGOOD + render_markfix -scheme -nocolour + set leaked [sgr_params $::punk::args::arg_error_CLR(goodarg)] + #the shared array now holds the strike-only nocolour style, not the pristine one + lappend result [expr {$leaked eq $NCGOOD}] + lappend result [expr {$leaked eq $GOOD}] + }\ + -cleanup { + punk::args::private::argerror_load_colours 1 + }\ + -result [list 1 0] + + test usagemarking_GAP_dash_nocolour_leak_affects_later_info_render {after a -scheme -nocolour render, an info-scheme render marks goodargs with the leaked strike-only style}\ + -setup $common -body { + variable GOOD + variable NCGOOD + render_markfix -scheme -nocolour + set argd [punk::args::parse {v1 0 1} withid ::testspace::markfix] + set out [render_markfix -scheme info -parsedargs $argd] + #marking present as strike (9) without the green (32) of the pristine goodarg style + lappend result [any_line_has_sgr $out lvarname $NCGOOD [lremove_params $GOOD $NCGOOD]] + lappend result [any_line_has_sgr $out lvarname $GOOD] + }\ + -cleanup { + punk::args::private::argerror_load_colours 1 + }\ + -result [list 1 0] +} +tcltest::cleanupTests ;#needed to produce test summary line. diff --git a/src/tests/modules/punk/ns/testsuites/ns/cmdhelp.test b/src/tests/modules/punk/ns/testsuites/ns/cmdhelp.test new file mode 100644 index 00000000..d31b2705 --- /dev/null +++ b/src/tests/modules/punk/ns/testsuites/ns/cmdhelp.test @@ -0,0 +1,487 @@ +package require tcltest + +package require punk::args +package require punk::ns +package require punk::ansi + +#Characterization of punk::ns::cmdhelp usage rendering ('i ') - added +#2026-07-10 ahead of G-049..G-052: scheme selection (error scheme for a failed parse of +#the supplied arguments, info scheme with goodarg marking for a successful one), badarg +#marking, the -return string renderer, the alias path, cmdinfo result shape, and GAP pins +#for the pseudo-command cmdtype (G-051), space-delimited-docid prefix matching (G-051), +#TclOO undocumented-method fallback (G-052) and synopsis marking absence (G-050). +#The marking primitives themselves (punk::args::arg_error -parsedargs/-badarg/-scheme) +#are pinned in src/tests/modules/punk/args/testsuites/args/usagemarking.test - this file +#pins that cmdhelp drives them correctly. +# +#Assertion approach (as usagemarking.test): expected SGR styles are read from the live +#colour arrays and matched by SGR parameter subset - renderers may merge/reorder codes. +#The info scheme's border (arg_error_CLR_info(ansiborder)) is the discriminating +#signature: present <=> info scheme; the error scheme's border shares its parameters +#with the info scheme's title so cannot discriminate on its own. + +namespace eval ::testspace { + namespace import ::tcltest::* + variable common { + set result "" + } + + #SGR colour generation (a+) is gated by punk::console colour state (e.g NO_COLOR env) + #force colour on for deterministic marking output + catch {package require punk::console} + if {[info commands ::punk::console::colour] ne ""} { + punk::console::colour on + } + + #--- helpers (same implementations as usagemarking.test - harmless if both loaded) ------ + #Origin note: deliberately test-local miniatures of punk's canonical ANSI-at-position + #mechanisms (punk::ansi::ansistring INDEXCODE / punk::ansi::ta / punk::ansi::codetype) + #- see the fuller origin note in usagemarking.test; the canonical mechanisms are + #covered directly in src/tests/modules/punk/ansi/testsuites/ansi/. + + #parameter list of the first SGR sequence in $code e.g \x1b\[32;9m -> {32 9} + proc sgr_params {code} { + if {[regexp {\x1b\[([0-9;]*)m} $code -> params]} { + return [split $params \;] + } + return {} + } + #1 if any single SGR sequence in $text contains every parameter in $params + #and none of the parameters in $withoutparams + proc has_sgr_with {text params {withoutparams {}}} { + if {![llength $params]} { + return 0 + } + foreach {match plist} [regexp -all -inline {\x1b\[([0-9;]*)m} $text] { + set pl [split $plist \;] + set ok 1 + foreach p $params { + if {$p ni $pl} {set ok 0; break} + } + foreach p $withoutparams { + if {$p in $pl} {set ok 0; break} + } + if {$ok} { + return 1 + } + } + return 0 + } + #raw lines of $rendered whose ANSI-stripped content contains $needle + proc lines_with {rendered needle} { + set out {} + foreach ln [split $rendered \n] { + if {[string first $needle [punk::ansi::ansistrip $ln]] >= 0} { + lappend out $ln + } + } + return $out + } + #1 if any line mentioning $needle carries an SGR containing all of $params (and none of $withoutparams) + proc any_line_has_sgr {rendered needle params {withoutparams {}}} { + foreach ln [lines_with $rendered $needle] { + if {[has_sgr_with $ln $params $withoutparams]} { + return 1 + } + } + return 0 + } + #active-SGR-parameter list per visible character of $ln (SGR codes applied in order; + #a code starting with parameter 0 - or an empty \x1b\[m - resets, other params accumulate) + proc char_sgr_map {ln} { + set map {} + set active {} + set i 0 + set len [string length $ln] + while {$i < $len} { + if {[string index $ln $i] eq "\x1b" && [regexp -start $i {\A\x1b\[([0-9;]*)m} $ln whole params]} { + set plist [split $params \;] + if {![llength $plist]} { + set active {} + } + foreach p $plist { + if {$p eq "" || $p == 0} { + set active {} + } elseif {$p ni $active} { + lappend active $p + } + } + incr i [string length $whole] + } else { + lappend map $active + incr i + } + } + return $map + } + #1 if every character of the first ANSI-stripped occurrence of $word in $ln has $param active + proc word_has_sgr_param {ln word param} { + set plain [punk::ansi::ansistrip $ln] + set start [string first $word $plain] + if {$start < 0} { + return 0 + } + set map [char_sgr_map $ln] + for {set i $start} {$i < $start + [string length $word]} {incr i} { + if {$param ni [lindex $map $i]} {return 0} + } + return 1 + } + #1 if any line of $rendered carries $word with every parameter of $params active across the whole word + proc rendered_word_has_sgr_params {rendered word params} { + if {![llength $params]} { + return 0 + } + foreach ln [lines_with $rendered $word] { + set all 1 + foreach p $params { + if {![word_has_sgr_param $ln $word $p]} {set all 0; break} + } + if {$all} { + return 1 + } + } + return 0 + } + + #--- fixtures ---------------------------------------------------------------------------- + + #the 'i ledit v1 0 1' shape: leader + solo opt + two typed values + proc helpfix {args} {} + punk::args::define { + @id -id ::testspace::helpfix + @cmd -name testspace::helpfix -summary "helpfix summary" -help "helpfix help" + @leaders -min 1 -max 1 + lvarname -type string + @opts + -flag -type none + @values -min 2 -max 2 + firstval -type int + lastval -type int + } + interp alias {} ::testspace::helpalias {} ::testspace::helpfix + interp alias {} ::testspace::helpcurry {} ::testspace::helpfix v1 + + #leader with restricted choices - a choiceviolation is the parse failure that carries -badarg + proc choosy {args} {} + punk::args::define { + @id -id ::testspace::choosy + @cmd -name testspace::choosy -summary "choosy summary" -help "choosy help" + @leaders -min 1 -max 1 + animal -choices {cat dog emu} + @opts + -shade -choices {light dark} -default dark + @values -min 1 -max 1 + volume -type int + } + + #documented parent whose subcommand doc exists only as a space-delimited id and whose + #choiceinfo has no subhelp mapping - models the tclcore 'string is ' docs + proc helpstr {args} {} + punk::args::define { + @id -id ::testspace::helpstr + @cmd -name testspace::helpstr -summary "helpstr parent" -help "helpstr parent" + @leaders -min 1 -max 1 + subcmd -choices {is compare} + @values -min 0 -max -1 + arg -optional 1 -multiple 1 + } + punk::args::define { + @id -id "::testspace::helpstr is" + @cmd -name "testspace::helpstr is" -summary "helpstr is summary" -help "helpstr is" + @values -min 1 -max 1 + str -type string + } + + #TclOO instance with one documented and one undocumented method (the + #punk::ansi::class::class_ansi rendertest/checksum situation) + oo::class create ::testspace::HelpClass { + method docmeth {a b} {return dm} + method plainmeth {x {y 1}} {return pm} + } + ::testspace::HelpClass create ::testspace::helpobj + punk::args::define { + @id -id "::testspace::HelpClass docmeth" + @cmd -name "testspace::HelpClass docmeth" -summary "docmeth summary" -help "docmeth help" + @values -min 2 -max 2 + avalue -type string + bvalue -type string + } + + #tclcore doc module supplies the real 'string is ' space-delimited ids + testConstraint have_tclcoredocs [expr {![catch {package require punk::args::moduledoc::tclcore}]}] + + #trigger the colour-array load, then capture the styles the tests assert against + punk::ns::cmdhelp ::testspace::helpfix + variable GOOD [sgr_params $::punk::args::arg_error_CLR(goodarg)] + variable BAD [sgr_params $::punk::args::arg_error_CLR(badarg)] + variable GOODCHOICE [sgr_params $::punk::args::arg_error_CLR(goodchoice)] + variable INFOBORDER [sgr_params $::punk::args::arg_error_CLR_info(ansiborder)] + + #--- cmdinfo result shape ---------------------------------------------------------------- + + test cmdhelp_cmdinfo_result_shape {cmdinfo returns the documented key set - synopsis and cmdhelp consume this shape}\ + -setup $common -body { + set cinfo [punk::ns::cmdinfo ::testspace::helpfix] + lappend result [dict keys $cinfo] + lappend result [dict get $cinfo cmdtype] [dict get $cinfo docid] + }\ + -cleanup { + }\ + -result [list {origin cmdtype args_resolved args_remaining docid stack} proc ::testspace::helpfix] + + #--- scheme selection -------------------------------------------------------------------- + + test cmdhelp_scheme_error_on_incomplete_args {insufficient arguments render the error scheme (no info border) with the parse error message}\ + -setup $common -body { + variable INFOBORDER + set out [punk::ns::cmdhelp ::testspace::helpfix v1] + lappend result [has_sgr_with $out $INFOBORDER] + #message wording varies by which check fails (count vs allocation) - both start "Bad number of" + lappend result [string match "Bad number of*" [punk::ansi::ansistrip [lindex [split $out \n] 0]]] + }\ + -cleanup { + }\ + -result [list 0 1] + + test cmdhelp_scheme_info_on_valid_args {a complete valid argument set renders the info scheme with received arguments goodarg-marked}\ + -setup $common -body { + variable INFOBORDER + variable GOOD + set out [punk::ns::cmdhelp ::testspace::helpfix v1 0 1] + lappend result [has_sgr_with $out $INFOBORDER] + lappend result [any_line_has_sgr $out lvarname $GOOD] + lappend result [any_line_has_sgr $out firstval $GOOD] + lappend result [any_line_has_sgr $out lastval $GOOD] + #-flag was not supplied - its row is not marked + lappend result [any_line_has_sgr $out -flag $GOOD] + }\ + -cleanup { + }\ + -result [list 1 1 1 1 0] + + test cmdhelp_badarg_marking_choiceviolation {a choice violation badarg-marks exactly the violating argument's row (error scheme)}\ + -setup $common -body { + variable INFOBORDER + variable BAD + set out [punk::ns::cmdhelp ::testspace::choosy horse 5] + lappend result [has_sgr_with $out $INFOBORDER] + lappend result [any_line_has_sgr $out animal $BAD] + lappend result [any_line_has_sgr $out volume $BAD] + }\ + -cleanup { + }\ + -result [list 0 1 0] + + test cmdhelp_goodchoice_highlighting {a valid invocation highlights the supplied choice word and the default-in-effect choice of an unsupplied opt (the 'i i' behaviour), in table and string renderers}\ + -setup $common -body { + variable GOODCHOICE + set out [punk::ns::cmdhelp ::testspace::choosy cat 5] + #supplied choice highlighted, siblings not + lappend result [rendered_word_has_sgr_params $out cat $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out dog $GOODCHOICE] + #-shade not supplied - its default 'dark' is the value in effect + lappend result [rendered_word_has_sgr_params $out dark $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out light $GOODCHOICE] + set out [punk::ns::cmdhelp -return string ::testspace::choosy cat 5] + lappend result [rendered_word_has_sgr_params $out cat $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out dark $GOODCHOICE] + lappend result [rendered_word_has_sgr_params $out light $GOODCHOICE] + }\ + -cleanup { + }\ + -result [list 1 0 1 0 1 1 0] + + test cmdhelp_explicit_scheme_honoured_on_success {an explicit -scheme overrides the automatic info scheme for a valid argument set}\ + -setup $common -body { + variable INFOBORDER + set out [punk::ns::cmdhelp -scheme error ::testspace::helpfix v1 0 1] + lappend result [has_sgr_with $out $INFOBORDER] + }\ + -cleanup { + }\ + -result [list 0] + + test cmdhelp_return_string_marking {goodarg marking is also applied by the -return string renderer}\ + -setup $common -body { + variable GOOD + set out [punk::ns::cmdhelp -return string ::testspace::helpfix v1 0 1] + lappend result [any_line_has_sgr $out lvarname $GOOD] + lappend result [any_line_has_sgr $out firstval $GOOD] + lappend result [any_line_has_sgr $out -flag $GOOD] + }\ + -cleanup { + }\ + -result [list 1 1 0] + + test cmdhelp_alias_path_marking {scheme selection and goodarg marking also work through the early alias resolution branch}\ + -setup $common -body { + variable INFOBORDER + variable GOOD + set out [punk::ns::cmdhelp ::testspace::helpalias v1 0 1] + lappend result [has_sgr_with $out $INFOBORDER] + lappend result [any_line_has_sgr $out lvarname $GOOD] + set out [punk::ns::cmdhelp ::testspace::helpalias v1] + lappend result [has_sgr_with $out $INFOBORDER] + }\ + -cleanup { + }\ + -result [list 1 1 0] + + #--- GAP pins: scheme/badarg asymmetries (G-049 candidates) ------------------------------- + #Pinned 2026-07-10 as characterization of current behaviour - a fix should flip these. + + test cmdhelp_GAP_no_badarg_marking_for_failed_typed_value {a value failing its -type check reports 'missingrequiredvalue' with NO badarg marking - only choice violations mark the bad argument}\ + -setup $common -body { + variable BAD + set out [punk::ns::cmdhelp ::testspace::helpfix v1 x x] + #the message names the failing argument but no row is badarg-marked + lappend result [string match "*fail on firstval*" [punk::ansi::ansistrip [lindex [split $out \n] 0]]] + lappend result [any_line_has_sgr $out firstval $BAD] + lappend result [any_line_has_sgr $out lastval $BAD] + }\ + -cleanup { + }\ + -result [list 1 0 0] + + test cmdhelp_GAP_explicit_scheme_ignored_on_failure {an explicit -scheme is honoured on the success path but IGNORED on the parse-failure path (the rendered error keeps the error scheme)}\ + -setup $common -body { + variable INFOBORDER + set out [punk::ns::cmdhelp -scheme info ::testspace::helpfix v1] + lappend result [has_sgr_with $out $INFOBORDER] + }\ + -cleanup { + }\ + -result [list 0] + + test cmdhelp_GAP_errormsg_leaks_internal_source {called at the global level (as from a repl), the parse-failure message shows cmdhelp's own unsubstituted source line as the caller instead of the queried command}\ + -setup $common -body { + #caller attribution depends on the invocation depth: from a nested context the + #message names the user's cmdhelp invocation (correct), but a top-level call - + #the interactive 'i ' case - walks to cmdhelp's internal parse call and + #shows its raw source text + set out [uplevel #0 [list punk::ns::cmdhelp ::testspace::helpfix v1]] + set line1 [punk::ansi::ansistrip [lindex [split $out \n] 0]] + lappend result [string match {*punk::args::parse $args_remaining*} $line1] + #from a nested context the same call attributes correctly + set out [punk::ns::cmdhelp ::testspace::helpfix v1] + set line1 [punk::ansi::ansistrip [lindex [split $out \n] 0]] + lappend result [string match {*punk::ns::cmdhelp*} $line1] + }\ + -cleanup { + }\ + -result [list 1 1] + + #--- GAP pins: pseudo-command cmdtype + space-delimited docid prefixes (G-051) ------------ + + test cmdhelp_GAP_pseudo_command_cmdtype_notfound {a space-delimited docid below a real command resolves its documentation but reports cmdtype 'notfound'}\ + -setup $common -body { + set cinfo [punk::ns::cmdinfo ::testspace::helpstr is] + lappend result [dict get $cinfo docid] [dict get $cinfo cmdtype] + set cinfo [punk::ns::cmdinfo ::testspace::helpstr is hello] + lappend result [dict get $cinfo docid] [dict get $cinfo args_remaining] + }\ + -cleanup { + }\ + -result [list {::testspace::helpstr is} notfound {::testspace::helpstr is} hello] + + test cmdhelp_GAP_spaceform_docid_prefix_not_honoured {parse accepts a unique choice prefix for the subcommand word but the space-delimited docid jump requires the exact word}\ + -setup $common -body { + #parse side: unique prefix 'i' of choice 'is' is accepted and normalized + set argd [punk::args::parse {i} withid ::testspace::helpstr] + lappend result [dict get [dict get $argd leaders] subcmd] + #doc-walk side: the same prefix does not reach the child docid + set cinfo [punk::ns::cmdinfo ::testspace::helpstr i] + lappend result [dict get $cinfo docid] [dict get $cinfo args_remaining] + }\ + -cleanup { + }\ + -result [list is ::testspace::helpstr i] + + test cmdhelp_GAP_string_is_true_pseudo {real-world pin: 'string is true' resolves its tclcore docid but reports cmdtype 'notfound'}\ + -constraints have_tclcoredocs\ + -setup $common -body { + set cinfo [punk::ns::cmdinfo ::string is true] + lappend result [dict get $cinfo docid] [dict get $cinfo cmdtype] + }\ + -cleanup { + }\ + -result [list {::tcl::string::is true} notfound] + + test cmdhelp_GAP_string_is_prefix_not_honoured {real-world pin: 'string is tr' works in Tcl but the doc walk stays at the parent docid}\ + -constraints have_tclcoredocs\ + -setup $common -body { + #Tcl itself accepts the class prefix + lappend result [string is tr 1] + set cinfo [punk::ns::cmdinfo ::string is tr] + lappend result [dict get $cinfo docid] [dict get $cinfo args_remaining] + }\ + -cleanup { + }\ + -result [list 1 ::tcl::string::is tr] + + #--- TclOO methods (G-052) ----------------------------------------------------------------- + + test cmdhelp_oo_documented_method {a documented method on an instance resolves to its class-level docid and gets goodarg marking}\ + -setup $common -body { + variable INFOBORDER + variable GOOD + set cinfo [punk::ns::cmdinfo ::testspace::helpobj docmeth] + lappend result [dict get $cinfo docid] + set out [punk::ns::cmdhelp ::testspace::helpobj docmeth aa bb] + lappend result [has_sgr_with $out $INFOBORDER] + lappend result [any_line_has_sgr $out avalue $GOOD] + lappend result [any_line_has_sgr $out bvalue $GOOD] + }\ + -cleanup { + }\ + -result [list {::testspace::HelpClass docmeth} 1 1 1] + + test cmdhelp_GAP_oo_undocumented_method_class_summary_only {an undocumented method falls back to the autogenerated class summary - bogus trailing arguments still render info scheme with the method word goodarg-marked}\ + -setup $common -body { + variable INFOBORDER + variable GOOD + set cinfo [punk::ns::cmdinfo ::testspace::helpobj plainmeth] + lappend result [dict get $cinfo cmdtype] [dict get $cinfo docid] + #no method-level (autodef) is generated from the method's own parameter list + set cinfo [punk::ns::cmdinfo ::testspace::helpobj plainmeth bogus1 bogus2 bogus3] + lappend result [dict get $cinfo docid] [dict get $cinfo args_remaining] + #the class-summary usage renders as a *valid* parse (info scheme, method marked) + #even though the trailing arguments are meaningless for plainmeth + set out [punk::ns::cmdhelp ::testspace::helpobj plainmeth bogus1 bogus2 bogus3] + lappend result [has_sgr_with $out $INFOBORDER] + lappend result [any_line_has_sgr $out method $GOOD] + }\ + -cleanup { + }\ + -result [list\ + ooobject (autodef)::testspace::helpobj\ + (autodef)::testspace::helpobj {plainmeth bogus1 bogus2 bogus3}\ + 1 1\ + ] + + #--- synopsis (G-050) ---------------------------------------------------------------------- + + test synopsis_GAP_no_argument_validity_marking {synopsis output carries no goodarg marking and is identical for valid, invalid and absent argument words}\ + -setup $common -body { + variable GOOD + set s1 [punk::ns::synopsis ::testspace::helpfix v1 0 1] + set s2 [punk::ns::synopsis ::testspace::helpfix v1 x x] + set s3 [punk::ns::synopsis ::testspace::helpfix] + lappend result [expr {$s1 eq $s2}] [expr {$s1 eq $s3}] + lappend result [has_sgr_with $s1 $GOOD] + }\ + -cleanup { + }\ + -result [list 1 1 0] + + test synopsis_curried_alias_shows_braced_target {REVIEW pin: synopsis of a curried alias substitutes the braced alias target, not the alias name (the 's pse' excess-args fudge)}\ + -setup $common -body { + set syn [punk::ansi::ansistrip [punk::ns::synopsis ::testspace::helpcurry]] + lappend result [lindex [split $syn \n] end] + }\ + -cleanup { + }\ + -result [list {{::testspace::helpfix v1} [-flag] firstval lastval}] +} +tcltest::cleanupTests ;#needed to produce test summary line.