From 454194492879a8f272f3960c6fce27d2902388a8 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Thu, 9 Jul 2026 04:43:10 +1000 Subject: [PATCH] punk::args rendering/quoting/choicegroups/examples characterization suite; helpers::example [a] fix Tests-first coverage pass (user-directed) before any changes to the definition-parsing/indentation machinery. punk/args suite: 128 tests, 15 files. - rendering.test (15): nesting independence (plain + tstr definitions render identically regardless of source-block indentation), relative-indent preservation (2-space help and 1-space choicelabel conventions, single and multiline - preservation, not enforcement), -unindentedfields (arg -help works left-margin; @cmd accepts-but-ignores it - GAP pinned), constructed (string-built) definition absolute-indent characterization ('constructed' to avoid confusion with the @dynamic directive), multiline ${[cmd]}/${$var}/ resolved_def insertions (aligned at insertion column, nesting-independent), and @dynamic ${$DYN_X} double substitution: stable across repeated resolutions, provider refresh honoured in help text, choice display and parse acceptance, textblock::frame-style art choicelabels byte-aligned - but multiline -help insertions land lines 2+ at insertion-4 (GAP pinned: the second-round subst path lacks paramindent re-alignment) - choicegroups.test (5): group/-choices union parsing, cross-group prefixes, duplicate-entry dedup, per-group titled choice tables (the punk::imap4 multi-table display), imap4-style {\Deleted}/{$MDNSent} values with labels incl. through tstr-bearing blocks; GAP pinned: prefix-normalization list-quotes special-character choices (exact '\Deleted' stores the plain string, prefix '\De' stores a one-element list) - value shape depends on input style - defquoting.test (3): container quoting rules pinned - braced values fully literal ($, [], two-char \n, bare backslashes), quoted values get Tcl backslash semantics (\n -> newline, \ -> \) with $/[] still literal, and \$\{...\} renders a literal ${...} in tstr-processed blocks - examples.test (6): helpers::example box/title/-tstr toggle (no-dedent direct-call contract pinned), ${[example ...]} insertion into @cmd help (bars at insertion column, content +2, automatic 'Example: eg ' row), @examples -> punk::args::eg with #/@# stripping (ANSI-tolerant), strip_nodisplay_lines unit, live tclcore ::lseq smoke - punk::args 0.3.1: helpers::example -title path called bare [a] (resolvable only where a punk shell's global alias exists - errored under plain tclsh); now punk::ansi::a. Found by examples.test in the runtests environment. - investigated punk::ansi::mark_columns first-call slowness (3.94s first, 60us after): argdoc -help calls a proc that calls mark_columns, whose parse resolves the same still-resolving definition - hazard already documented in-source with candidate fixes; recorded in CHANGELOG for goal consideration, deliberately not patched - project 0.4.11 (CHANGELOG entry) Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- CHANGELOG.md | 10 + punkproject.toml | 2 +- src/modules/punk/args-999999.0a1.0.tm | 2 +- src/modules/punk/args-buildversion.txt | 3 +- .../args/testsuites/args/choicegroups.test | 161 +++++ .../punk/args/testsuites/args/defquoting.test | 127 ++++ .../punk/args/testsuites/args/examples.test | 152 +++++ .../punk/args/testsuites/args/rendering.test | 612 ++++++++++++++++++ 8 files changed, 1066 insertions(+), 3 deletions(-) create mode 100644 src/tests/modules/punk/args/testsuites/args/choicegroups.test create mode 100644 src/tests/modules/punk/args/testsuites/args/defquoting.test create mode 100644 src/tests/modules/punk/args/testsuites/args/examples.test create mode 100644 src/tests/modules/punk/args/testsuites/args/rendering.test diff --git a/CHANGELOG.md b/CHANGELOG.md index 67e1f95c..6c136f6d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,16 @@ 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` "Project Versioning" section for the bump policy. +## [0.4.11] - 2026-07-09 + +- punk::args 0.3.1: fixed `helpers::example` `-title` path calling bare `[a]` (resolvable only where a global `a` alias exists, e.g. punk shells — errored under plain tclsh); found by the new test coverage. +- punk::args test suite grown to 128 tests across 15 files with four new characterization areas, added before any changes to the definition-parsing/indentation machinery (user-directed tests-first): + - rendering.test (15): nesting independence (plain + tstr defs), relative-indent preservation (the 2-space help and 1-space choicelabel conventions, single and multiline), `-unindentedfields` (arg ✓; `@cmd` accepts-but-ignores — GAP pinned), constructed (string-built) definition absolute-indent characterization, multiline `${[cmd]}`/`${$var}`/`resolved_def` insertions (aligned, nesting-independent), and `@dynamic` `${$DYN_X}` double substitution (stable across resolutions, provider refresh honoured in help/choices/parse, textblock::frame-style art choicelabels byte-aligned — but multiline `-help` insertions lose insertion-column alignment for lines 2+, GAP pinned: the second-round subst lacks paramindent re-alignment). + - choicegroups.test (5): group/`-choices` union parsing, cross-group prefixes, duplicate-entry dedup, per-group titled choice tables, and punk::imap4-style `{\Deleted}`/`{$MDNSent}` values with labels — plus a GAP pin: prefix-normalization list-quotes special-character choices (`\De` stores `{\Deleted}` where exact input stores plain `\Deleted`). + - defquoting.test (3): container quoting rules pinned — braced values fully literal (`$`, `[]`, two-char `\n`, bare backslashes), quoted values get Tcl backslash semantics (`\n` → newline, `\\` → `\`) with `$`/`[]` still literal, and `\$\{...\}` renders a literal `${...}` in tstr-processed blocks. + - examples.test (6): helpers::example box structure/title/`-tstr` toggle (no-dedent direct-call contract pinned), `${[example ...]}` insertion into `@cmd` help aligned with the auto `Example:` row, `@examples` → `punk::args::eg` with `#`/`@#` stripping (ANSI-tolerant), strip_nodisplay_lines unit, and a live tclcore `::lseq` smoke (the heaviest example consumer). +- Investigated punk::ansi::mark_columns first-call slowness (reproduced: 3.94s first call, 60µs thereafter): the argdoc `-help` contains `${[...num_columns_example]}` which itself calls `mark_columns`, whose parse resolves the same still-resolving definition — the in-source TODO already documents the recursion hazard and candidate fixes (reentrancy guard, or deferring `-help` processing out of argument resolution, which would also help general first-parse performance). Recorded for goal consideration rather than patched. + ## [0.4.10] - 2026-07-08 - G-040 completed (activated and flipped to achieved same day, user-directed): punk::args 0.3.0 adds `-choicealiases {alias canonical ...}` — aliases accepted exact under any `-choiceprefix`/`-nocase` setting, participating in prefix calculation when prefixing is on, always normalizing to the canonical choice in parse results; deny semantics apply to the matched name (a denied alias needs the full alias; a canonical reached via its alias is exempt from the canonical's own deny entry); usage display folds aliases into the canonical entry as an `(alias: …)` label note. The choice-word matching chain was extracted from `get_dict` into the shared resolver `punk::args::choiceword_match`, now also consumed by punk::ns 0.1.2's `cmd_traverse` — closing the doc-lookup parity gap (deny/reserve lists were honoured by parse but ignored by the walk; the pinned GAP tests flipped to agreement) and normalizing aliases before choiceinfo lookup. diff --git a/punkproject.toml b/punkproject.toml index 07bec260..df96223a 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,3 +1,3 @@ [project] name = "punkshell" -version = "0.4.10" +version = "0.4.11" diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 8eab7477..b3fc4860 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -416,7 +416,7 @@ tcl::namespace::eval ::punk::args::helpers { } if {$opt_title ne ""} { - set title "[punk::ansi::a+ term-black Term-silver]$opt_title[a]" + set title "[punk::ansi::a+ term-black Term-silver]$opt_title[punk::ansi::a]" } else { set title "" } diff --git a/src/modules/punk/args-buildversion.txt b/src/modules/punk/args-buildversion.txt index 847b0dc4..25dc5c4e 100644 --- a/src/modules/punk/args-buildversion.txt +++ b/src/modules/punk/args-buildversion.txt @@ -1,6 +1,7 @@ -0.3.0 +0.3.1 #First line must be a semantic version number #all other lines are ignored. +#0.3.1 - fixed helpers::example -title path calling bare [a] (only resolvable where a global 'a' alias exists, e.g. punk shells) - now punk::ansi::a; found by the new examples.test running under plain tclsh #0.3.0 - new: -choicealiases {alias canonical ...} argument option (G-040) - aliases accepted exact under any -choiceprefix/-nocase setting, join the prefix-calculation pool when -choiceprefix is true, and normalize to their canonical choice in parse results; deny applies to the matched name (alias deny requires full alias; canonical reached via alias exempt from the canonical's own deny); usage display folds aliases into the canonical entry's label as an (alias:...) note and includes alias names in display prefix calculation; alias->existing-choice and no-collision validated at definition resolve. new public helper punk::args::choiceword_match - the single choice-word matching implementation extracted from get_dict, also consumed by punk::ns cmd_traverse for doc-lookup parity #0.2.3 - fixed "@opts -any 1" adhoc option passthrough: an option not in the definition crashed get_dict ("can't read argname") at the name-mapping stage instead of passing through - adhoc opts now fall back to their raw supplied name (argstate/arg_checks already carried them); commented out a debug puts stderr (">>>_get_dict_can_assign_value NOT alloc_ok...") that fired on every failed clause type assignment (e.g. any multiform parse miss) #0.2.2 - documentation-only: define doc clarifies -choicerestricted 0 passthrough (non-matching/ambiguous/denied/reserved words accepted as ordinary values), -choiceprefix result normalization to the canonical choice + minimal-prefix display highlighting, -choiceprefixdenylist behaviour for shorter prefixes in both restricted modes, and -choiceprefixreservelist phantom-entry idiom for per-choice minimum-prefix control diff --git a/src/tests/modules/punk/args/testsuites/args/choicegroups.test b/src/tests/modules/punk/args/testsuites/args/choicegroups.test new file mode 100644 index 00000000..f7faa9dc --- /dev/null +++ b/src/tests/modules/punk/args/testsuites/args/choicegroups.test @@ -0,0 +1,161 @@ +package require tcltest + +package require punk::args +package require punk::ansi + +#-choicegroups coverage - added 2026-07-09 (motivating consumer: punk::imap4's flagname +#argument, which uses multiple named groups displayed as separate choice tables, with +#choice values containing leading backslashes ({\Deleted}) and dollar signs ({$MDNSent})). + +namespace eval ::testspace { + namespace import ::tcltest::* + variable common { + set result "" + } + + proc cg_render {id} { + return [punk::ansi::ansistrip [punk::args::arg_error "" [punk::args::get_spec $id] -aserror 0]] + } + + punk::args::define { + @id -id ::testspace::cgroups + @cmd -name testspace::cgroups -summary\ + "Choicegroups fixture."\ + -help\ + "cmd help." + @values -min 1 -max 1 + flag -choices {GDELTA} -choicegroups { + GroupOne {GALPHA GBETA} + GroupTwo {GGAMMA GALPHA} + } -choicelabels { + GALPHA " alpha label" + } -help\ + "flag help." + } + + test choicegroups_parse_union {members of any group and of -choices all parse; prefixes resolve across the union; an entry duplicated across groups still prefix-matches}\ + -setup $common -body { + foreach word {GALPHA GGAMMA GDELTA} { + lappend result [dict get [punk::args::parse [list $word] withid ::testspace::cgroups] values] + } + #unique prefix across the whole union + lappend result [dict get [punk::args::parse {GG} withid ::testspace::cgroups] values] + #GALPHA appears in two groups - deduped for prefix calculation (GA still unique) + lappend result [dict get [punk::args::parse {GA} withid ::testspace::cgroups] values] + #a non-member is rejected (restricted default) + if {[catch {punk::args::parse {GZZZ} withid ::testspace::cgroups}]} { + lappend result nonmember-rejected + } else { + lappend result nonmember-UNEXPECTEDLY-accepted + } + }\ + -cleanup { + }\ + -result [list\ + {flag GALPHA}\ + {flag GGAMMA}\ + {flag GDELTA}\ + {flag GGAMMA}\ + {flag GALPHA}\ + nonmember-rejected\ + ] + + test choicegroups_display_group_tables {each named group renders as its own titled choice table; ungrouped -choices render first; labels attach within groups}\ + -setup $common -body { + set r [cg_render ::testspace::cgroups] + #group names appear (as table titles) + lappend result [string match "*GroupOne*" $r] + lappend result [string match "*GroupTwo*" $r] + #all members and the ungrouped choice present + foreach word {GALPHA GBETA GGAMMA GDELTA} { + lappend result [expr {[string first $word $r] >= 0}] + } + #the label attaches to the grouped choice + lappend result [string match "*alpha label*" $r] + #ungrouped table comes before the group tables + lappend result [expr {[string first GDELTA $r] < [string first GroupOne $r]}] + }\ + -cleanup { + }\ + -result [list 1 1 1 1 1 1 1 1] + + punk::args::define { + @id -id ::testspace::cgimap + @cmd -name testspace::cgimap -summary\ + "Imap-style values fixture."\ + -help\ + "cmd help." + @values -min 1 -max 1 + flagname -choicerestricted 0 -choicegroups { + SystemFlags {{\Deleted} {\Flagged}} + Keywords {{$MDNSent} {$Forwarded}} + } -choicelabels { + {\Deleted}\ + { Message is deleted} + $Forwarded\ + " Message forwarded" + } -help\ + "flagname help." + } + + test choicegroups_imap_special_values_parse_and_display {choice values with leading backslashes and dollar signs parse exactly and display with their labels (the punk::imap4 flagname pattern)}\ + -setup $common -body { + set argd [punk::args::parse [list "\\Deleted"] withid ::testspace::cgimap] + lappend result [expr {[dict get [dict get $argd values] flagname] eq "\\Deleted"}] + set argd [punk::args::parse [list "\$MDNSent"] withid ::testspace::cgimap] + lappend result [expr {[dict get [dict get $argd values] flagname] eq "\$MDNSent"}] + set r [cg_render ::testspace::cgimap] + lappend result [expr {[string first "\\Deleted" $r] >= 0}] + lappend result [expr {[string first "\$MDNSent" $r] >= 0}] + lappend result [string match "*Message is deleted*" $r] + lappend result [string match "*Message forwarded*" $r] + }\ + -cleanup { + }\ + -result [list 1 1 1 1 1 1] + + test choicegroups_imap_prefix_listwrap_GAP {GAP: prefix-normalizing a choice containing a backslash stores a list-quoted value ({\Deleted}) where exact input stores the plain string - value shape depends on how the user typed it}\ + -setup $common -body { + #the prefix-normalization writeback (lset into the stored value) list-quotes + #values needing quoting (backslashes, spaces). Exact input bypasses the + #writeback and stays a plain string. Pinned as characterization pending a fix. + set exact [dict get [dict get [punk::args::parse [list "\\Deleted"] withid ::testspace::cgimap] values] flagname] + set viapfx [dict get [dict get [punk::args::parse [list "\\De"] withid ::testspace::cgimap] values] flagname] + lappend result [expr {$exact eq "\\Deleted"}] + #current (GAP) behaviour: the prefix path yields a one-element list + lappend result [expr {$viapfx ne "\\Deleted"}] + lappend result [expr {[lindex $viapfx 0] eq "\\Deleted"}] + }\ + -cleanup { + }\ + -result [list 1 1 1] + + test choicegroups_special_values_survive_tstr_block {backslash/dollar choice values are untouched when the definition block also contains ${...} tstr content}\ + -setup $common -body { + variable CGEXTRA "tstr-extra" + punk::args::define { + @id -id ::testspace::cgimaptstr + @cmd -name testspace::cgimaptstr -summary\ + "Imap-tstr fixture ${$CGEXTRA}."\ + -help\ + "cmd help." + @values -min 1 -max 1 + flagname -choicegroups { + SystemFlags {{\Deleted} {\Flagged}} + Keywords {{$MDNSent}} + } -help\ + "flagname help." + } + set argd [punk::args::parse [list "\\Flagged"] withid ::testspace::cgimaptstr] + lappend result [expr {[dict get [dict get $argd values] flagname] eq "\\Flagged"}] + set argd [punk::args::parse [list "\$MDNSent"] withid ::testspace::cgimaptstr] + lappend result [expr {[dict get [dict get $argd values] flagname] eq "\$MDNSent"}] + #and the tstr content itself expanded + lappend result [string match "*tstr-extra*" [cg_render ::testspace::cgimaptstr]] + }\ + -cleanup { + punk::args::undefine ::testspace::cgimaptstr 1 + }\ + -result [list 1 1 1] +} +tcltest::cleanupTests ;#needed to produce test summary line. diff --git a/src/tests/modules/punk/args/testsuites/args/defquoting.test b/src/tests/modules/punk/args/testsuites/args/defquoting.test new file mode 100644 index 00000000..7aadd5ae --- /dev/null +++ b/src/tests/modules/punk/args/testsuites/args/defquoting.test @@ -0,0 +1,127 @@ +package require tcltest + +package require punk::args +package require punk::ansi + +#Quoting/escaping characterization for punk::args definition blocks - added 2026-07-09. +#Definition records pass through record parsing and (when ${ is present) tstr - these +#tests pin what survives in each container type so documenters know the rules: +# +# braced {...} values : fully literal - $, [], backslash sequences (\n stays two chars, +# \Deleted keeps its backslash). Only ${...} tstr placeholders +# (when present anywhere in the block) and the \$\{ escape are +# special. +# quoted "..." values : Tcl backslash semantics apply at record parse - \n becomes a +# real newline, \\ collapses to \ - while $ and [] remain literal +# (no variable/command substitution on record content outside +# tstr placeholders). + +namespace eval ::testspace { + namespace import ::tcltest::* + variable common { + set result "" + } + + proc dq_render {id} { + return [punk::ansi::ansistrip [punk::args::arg_error "" [punk::args::get_spec $id] -aserror 0]] + } + proc dq_linewith {rendered marker} { + foreach ln [split $rendered \n] { + if {[string first $marker $ln] >= 0} { + return $ln + } + } + return "" + } + + test defquoting_braced_help_literal {braced -help values are literal: $, [], backslash-n (two chars) and bare backslashes all survive}\ + -setup $common -body { + punk::args::define { + @id -id ::testspace::dqbraced + @cmd -name testspace::dqbraced -summary\ + "Braced quoting fixture."\ + -help\ + "cmd help." + @values -min 1 -max 1 + v1 -type string -help\ + {BDOLLAR literal $notavar stays. + BBRACKET literal [lindex x 0] stays. + BBACKSLASHN one\ntwo stays two chars. + BSINGLE bare \Deleted keeps backslash.} + } + set r [dq_render ::testspace::dqbraced] + lappend result [expr {[string first {$notavar} $r] >= 0}] + lappend result [expr {[string first {[lindex x 0]} $r] >= 0}] + #backslash-n stays literal two characters (one\ntwo on ONE line) + lappend result [expr {[string first {one\ntwo} [dq_linewith $r BBACKSLASHN]] >= 0}] + lappend result [expr {[string first "\\Deleted" $r] >= 0}] + }\ + -cleanup { + punk::args::undefine ::testspace::dqbraced 1 + }\ + -result [list 1 1 1 1] + + test defquoting_quoted_help_backslash_semantics {quoted -help values get Tcl backslash processing (\n -> newline, \\ -> \) while $ and [] stay literal}\ + -setup $common -body { + punk::args::define { + @id -id ::testspace::dqquoted + @cmd -name testspace::dqquoted -summary\ + "Quoted quoting fixture."\ + -help\ + "cmd help." + @values -min 1 -max 1 + v1 -type string -help\ + "QDOLLAR literal $notavar stays. + QBRACKET literal [lindex x 0] stays. + QSPLIT one\ntwo becomes a real newline. + QDOUBLEBS double \\Deleted collapses to one backslash." + } + set r [dq_render ::testspace::dqquoted] + lappend result [expr {[string first {$notavar} $r] >= 0}] + lappend result [expr {[string first {[lindex x 0]} $r] >= 0}] + #the \n split: 'one' ends its line - 'two becomes' is on a different line + set splitline [dq_linewith $r QSPLIT] + lappend result [expr {[string first "two becomes" $splitline] < 0}] + lappend result [expr {[string first "two becomes" $r] >= 0}] + #escaped backslash collapses to a single one + lappend result [expr {[string first "\\Deleted" $r] >= 0}] + lappend result [expr {[string first "\\\\Deleted" $r] < 0}] + }\ + -cleanup { + punk::args::undefine ::testspace::dqquoted 1 + }\ + -result [list 1 1 1 1 1 1] + + test defquoting_tstr_placeholder_escape {in a tstr-processed block (contains ${...}), the \$\{...\} escape renders a literal ${...}}\ + -setup $common -body { + variable DQX "expanded-value" + punk::args::define { + @id -id ::testspace::dqescape + @cmd -name testspace::dqescape -summary\ + "Tstr escape fixture."\ + -help\ + "TSUB gives ${$DQX} here. + TLIT shows \$\{$DQX\} literally." + @values -min 0 -max 0 + } + set r [dq_render ::testspace::dqescape] + #the unescaped placeholder substituted + lappend result [expr {[string first "TSUB gives expanded-value" $r] >= 0}] + #the escaped form renders as a literal ${...} (documentation-of-tstr idiom, + #as used in punk::args' own define doc) + lappend result [expr {[string first "TLIT shows \$\{\$DQX\}" $r] >= 0 || [string first {TLIT shows ${$DQX}} $r] >= 0}] + #record which literal form rendered (characterization) + if {[string first {TLIT shows ${$DQX}} $r] >= 0} { + lappend result rendered-as-dollarbrace + } elseif {[string first "TLIT shows" $r] >= 0} { + lappend result [dq_linewith $r TLIT] + } else { + lappend result tlit-line-missing + } + }\ + -cleanup { + punk::args::undefine ::testspace::dqescape 1 + }\ + -result [list 1 1 rendered-as-dollarbrace] +} +tcltest::cleanupTests ;#needed to produce test summary line. diff --git a/src/tests/modules/punk/args/testsuites/args/examples.test b/src/tests/modules/punk/args/testsuites/args/examples.test new file mode 100644 index 00000000..25d88573 --- /dev/null +++ b/src/tests/modules/punk/args/testsuites/args/examples.test @@ -0,0 +1,152 @@ +package require tcltest + +package require punk::args +package require punk::ansi + +#punk::args::helpers::example / @examples directive / punk::args::eg coverage - added +#2026-07-09. The example helper is heavily used by punk::args::moduledoc::tclcore (e.g. +#::lseq uses it both inside @cmd -help and in the @examples directive shown via 'eg'). +#See also punk::args::helpers::strip_nodisplay_lines whose own doc describes the +## / @# line conventions these tests exercise. + +namespace eval ::testspace { + namespace import ::tcltest::* + variable common { + set result "" + } + + proc eg_render {id} { + return [punk::ansi::ansistrip [punk::args::arg_error "" [punk::args::get_spec $id] -aserror 0]] + } + proc eg_markercol {rendered marker} { + foreach ln [split $rendered \n] { + set ix [string first $marker $ln] + if {$ix >= 0} { + return $ix + } + } + return -1 + } + + test example_box_structure {helpers::example wraps text in a bar-bounded box; text is used as-is (no dedent - callers/definition blocks are expected to have dedented already)}\ + -setup $common -body { + #direct calls receive the text VERBATIM (the helper documents that it performs + #no further dedenting - in define blocks the block normalization handles it, + #so authors there write examples with a 2-space relative indent) + set ex [punk::ansi::ansistrip [punk::args::helpers::example " set x 1\n puts \"hello\""]] + set lines [split $ex \n] + #top and bottom bars are unicode block characters (visible even ANSI-stripped) + lappend result [string match "▀*" [string trim [lindex $lines 0]]] + lappend result [string match "▄*" [string trim [lindex $lines end]]] + #content preserved with the author's 2-space indent intact + lappend result [expr {[eg_markercol $ex {set x 1}] == 2}] + lappend result [expr {[eg_markercol $ex {puts "hello"}] == 2}] + }\ + -cleanup { + }\ + -result [list 1 1 1 1] + + test example_title_and_tstr_options {-title appears in the top bar; -tstr 1 (default) substitutes ${[...]}; -tstr 0 leaves it literal}\ + -setup $common -body { + set ex [punk::ansi::ansistrip [punk::args::helpers::example -title "EXTITLE" { + content line + }]] + lappend result [string match "*EXTITLE*" [lindex [split $ex \n] 0]] + #default -tstr 1: placeholder substituted + set ex2 [punk::ansi::ansistrip [punk::args::helpers::example { + value is ${[string repeat X 3]} + }]] + lappend result [expr {[string first "value is XXX" $ex2] >= 0}] + #-tstr 0: placeholder left literal + set ex3 [punk::ansi::ansistrip [punk::args::helpers::example -tstr 0 -syntax none { + value is ${[string repeat X 3]} + }]] + lappend result [expr {[string first "value is \$\{\[string repeat X 3\]\}" $ex3] >= 0}] + }\ + -cleanup { + }\ + -result [list 1 1 1] + + test example_inserted_in_cmd_help {an ${[helpers::example {...}]} block inside @cmd -help renders its box aligned at the insertion column}\ + -setup $common -body { + punk::args::define { + @id -id ::testspace::egincmd + @cmd -name testspace::egincmd -summary\ + "Example-in-help fixture."\ + -help\ + "XFIRST help line. + ${[punk::args::helpers::example { + set demo 1 + puts XBODY + }]} + XLAST help line." + @values -min 0 -max 0 + } + set r [eg_render ::testspace::egincmd] + set x0 [eg_markercol $r XFIRST] + #the box bars align at the insertion column; content sits 2 inside + lappend result [expr {[eg_markercol $r ▀] - $x0}] + lappend result [expr {[eg_markercol $r {set demo 1}] - $x0}] + lappend result [expr {[eg_markercol $r XBODY] - [eg_markercol $r {set demo 1}]}] + lappend result [expr {[eg_markercol $r XLAST] - $x0}] + }\ + -cleanup { + punk::args::undefine ::testspace::egincmd 1 + }\ + -result [list 0 2 5 0] + + test atexamples_eg_and_usage_row {@examples -help is returned by punk::args::eg with #/@# lines stripped, and the usage table gains an Example row}\ + -setup $common -body { + punk::args::define { + @id -id ::testspace::egdirective + @cmd -name testspace::egdirective -summary\ + "Examples directive fixture."\ + -help\ + "cmd help." + @values -min 0 -max 0 + @examples -help\ + "EGLINE1 first example line + # hidden balancing line + @# also hidden + EGLINE2 second example line" + } + set eg [punk::args::eg ::testspace::egdirective] + lappend result [string match "*EGLINE1*" $eg] + lappend result [string match "*EGLINE2*" $eg] + lappend result [string match "*hidden*" $eg] + #the usage table advertises the examples + set r [eg_render ::testspace::egdirective] + lappend result [string match "*Example:*" $r] + lappend result [string match "*eg ::testspace::egdirective*" $r] + }\ + -cleanup { + punk::args::undefine ::testspace::egdirective 1 + }\ + -result [list 1 1 0 1 1] + + test strip_nodisplay_lines_unit {strip_nodisplay_lines removes # and @# lines (ANSI and leading whitespace tolerated) and keeps the rest}\ + -setup $common -body { + set intext "keep1\n # gone\n@# also gone\n\x1b\[31m # ansi-prefixed gone\x1b\[m\nkeep2" + set out [punk::args::helpers::strip_nodisplay_lines $intext] + lappend result [string map [list \n |] $out] + }\ + -cleanup { + }\ + -result [list "keep1|keep2"] + + test tclcore_lseq_examples_live {the tclcore moduledoc's ::lseq definition (a heavy example consumer) resolves, renders, and serves 'eg' content}\ + -setup $common -body { + package require punk::args::moduledoc::tclcore + set spec [punk::args::get_spec ::lseq] + lappend result [dict exists $spec examples_info -help] + #eg output substantial (the helper-formatted example blocks) + lappend result [expr {[string length [punk::args::eg ::lseq]] > 100}] + #the usage render (which processes the @cmd -help example blocks) succeeds + set r [eg_render ::lseq] + lappend result [expr {[string length $r] > 500}] + }\ + -cleanup { + }\ + -result [list 1 1 1] +} +tcltest::cleanupTests ;#needed to produce test summary line. diff --git a/src/tests/modules/punk/args/testsuites/args/rendering.test b/src/tests/modules/punk/args/testsuites/args/rendering.test new file mode 100644 index 00000000..2fc24230 --- /dev/null +++ b/src/tests/modules/punk/args/testsuites/args/rendering.test @@ -0,0 +1,612 @@ +package require tcltest + +package require punk::args +package require punk::ansi + +#Rendering/indentation characterization for punk::args usage output - added 2026-07-09 +#before any changes to the definition-block parsing / indentation machinery (per user +#direction). These tests encode the load-bearing properties as RELATIVE-position +#assertions on unique marker strings, so they don't depend on table geometry and don't +#require eyeballing snapshots: +# +# P1 nesting independence: a definition renders identically regardless of the source +# code indentation of the block it is written in (with and without ${...} tstr +# content) +# P2 relative-indent preservation: the documenter's continuation-line indentation +# conventions (e.g. lines 2+ indented by 2) survive to display, measured relative +# to the first line - punk::args preserves but does not enforce them +# P3 -unindentedfields: left-margin authoring works for argument -help (and is +# currently accepted but IGNORED for @cmd -help - pinned as a GAP) +# P4 constructed (string-built) definitions receive no whole-block indent +# normalization ('constructed' - not to be confused with the @dynamic directive): +# embedded continuation indentation is interpreted via the display-time +# undent(prefix4,max4) transform, so continuations written at exactly 4 spaces +# align flush with the first line, and any other depth misaligns (pinned as +# characterization - this is why ::punk::helptopic::define_docs pre-normalizes) +# P5 tstr ${...} substitutions with MULTILINE results (command or variable) insert +# aligned at the insertion column with the inserted text's own relative indents +# preserved (the -paramindents machinery) - including whole-definition insertion +# via punk::args::resolved_def +# P6 @dynamic definitions (the ${$DYN_SOMENAME} double-substitution idiom: an +# UPPERCASE-by-convention variable whose value is itself a tstr placeholder, +# re-evaluated at parse/help time): rendering is stable across repeated +# resolutions, refreshes when the underlying provider changes, and the +# textblock::frame art-choicelabel pattern renders byte-aligned - but multiline +# results inserted into -help lose the insertion-column alignment for lines 2+ +# (pinned as a GAP: the second-round subst path lacks the paramindent +# re-alignment that single-level ${[cmd]} insertion gets in P5) +# +#Renderers covered: the default table renderer (punk::args::arg_error) and the +#-return string renderer. + +namespace eval ::testspace { + namespace import ::tcltest::* + variable common { + set result "" + } + + proc render_table {id} { + return [punk::ansi::ansistrip [punk::args::arg_error "" [punk::args::get_spec $id] -aserror 0]] + } + proc render_string {id} { + return [punk::ansi::ansistrip [punk::args::arg_error "" [punk::args::get_spec $id] -aserror 0 -return string]] + } + #column (0-based) at which a unique marker string appears in the rendered text, -1 if absent + proc markercol {rendered marker} { + foreach ln [split $rendered \n] { + set ix [string first $marker $ln] + if {$ix >= 0} { + return $ix + } + } + return -1 + } + + #--- P1 nesting independence -------------------------------------------------------- + + test rendering_nesting_independence_plain {a plain definition renders identically at different source-block indentations}\ + -setup $common -body { + punk::args::define { + @id -id ::testspace::rnest + @cmd -name testspace::rnest -summary\ + "Nest fixture."\ + -help\ + "NFIRST line. + NFLUSH line. + NPLUS2 line." + @values -min 1 -max 1 + v1 -type string -help\ + "NAFIRST line. + NAPLUS2 line." + } + set r_shallow [render_table ::testspace::rnest] + punk::args::undefine ::testspace::rnest 1 + namespace eval nestlevel1 { + namespace eval nestlevel2 { + namespace eval nestlevel3 { + punk::args::define { + @id -id ::testspace::rnest + @cmd -name testspace::rnest -summary\ + "Nest fixture."\ + -help\ + "NFIRST line. + NFLUSH line. + NPLUS2 line." + @values -min 1 -max 1 + v1 -type string -help\ + "NAFIRST line. + NAPLUS2 line." + } + } + } + } + set r_deep [render_table ::testspace::rnest] + lappend result [expr {$r_shallow eq $r_deep}] + #and the deep rendering is properly aligned in its own right + lappend result [expr {[markercol $r_deep NFIRST] == [markercol $r_deep NFLUSH]}] + }\ + -cleanup { + punk::args::undefine ::testspace::rnest 1 + }\ + -result [list 1 1] + + test rendering_nesting_independence_tstr {a definition containing ${...} tstr content renders identically at different source-block indentations}\ + -setup $common -body { + variable RSUM "Tstr nest fixture." + punk::args::define { + @id -id ::testspace::rtnest + @cmd -name testspace::rtnest -summary\ + "${$RSUM}"\ + -help\ + "TFIRST line. + TFLUSH line. + TPLUS2 line." + @values -min 1 -max 1 + v1 -type string -help\ + "TAFIRST line. + TAPLUS2 line." + } + set r_shallow [render_table ::testspace::rtnest] + punk::args::undefine ::testspace::rtnest 1 + namespace eval nestlevel1 { + namespace eval nestlevel2 { + namespace eval nestlevel3 { + variable RSUM "Tstr nest fixture." + punk::args::define { + @id -id ::testspace::rtnest + @cmd -name testspace::rtnest -summary\ + "${$RSUM}"\ + -help\ + "TFIRST line. + TFLUSH line. + TPLUS2 line." + @values -min 1 -max 1 + v1 -type string -help\ + "TAFIRST line. + TAPLUS2 line." + } + } + } + } + set r_deep [render_table ::testspace::rtnest] + lappend result [expr {$r_shallow eq $r_deep}] + #tstr summary expanded (not left as a placeholder) + lappend result [string match "*Tstr nest fixture.*" $r_deep] + }\ + -cleanup { + punk::args::undefine ::testspace::rtnest 1 + }\ + -result [list 1 1] + + #--- P2 relative-indent preservation (canonical file-style authoring) ---------------- + + test rendering_table_alignment_canonical {table renderer: cmd-help and arg-help continuations align with their first line; the +2 convention is preserved}\ + -setup $common -body { + punk::args::define { + @id -id ::testspace::ralign + @cmd -name testspace::ralign -summary\ + "Align fixture."\ + -help\ + "CFIRST line. + CFLUSH line. + CPLUS2 line." + @values -min 1 -max 1 + v1 -type string -help\ + "AFIRST line. + AFLUSH line. + APLUS2 line." + } + set r [render_table ::testspace::ralign] + #cmd help: flush continuation same column as first line, +2 line two right + set c0 [markercol $r CFIRST] + lappend result [expr {[markercol $r CFLUSH] - $c0}] + lappend result [expr {[markercol $r CPLUS2] - $c0}] + #arg help: same properties in the Help column + set a0 [markercol $r AFIRST] + lappend result [expr {[markercol $r AFLUSH] - $a0}] + lappend result [expr {[markercol $r APLUS2] - $a0}] + }\ + -cleanup { + punk::args::undefine ::testspace::ralign 1 + }\ + -result [list 0 2 0 2] + + test rendering_string_renderer_characterization {string renderer: arg-help aligned with +2 preserved; cmd-help first line joins the Description label while continuations sit flush-left (first-vs-rest offset is a known wart)}\ + -setup $common -body { + punk::args::define { + @id -id ::testspace::rstring + @cmd -name testspace::rstring -summary\ + "String renderer fixture."\ + -help\ + "SFIRST line. + SFLUSH line. + SPLUS2 line." + @values -min 1 -max 1 + v1 -type string -help\ + "SAFIRST line. + SAPLUS2 line." + } + set r [render_string ::testspace::rstring] + #arg help: relative +2 preserved, first line and continuation share a base + set a0 [markercol $r SAFIRST] + lappend result [expr {[markercol $r SAPLUS2] - $a0}] + #cmd help: first line rendered on the Description: line ... + set descline "" + foreach ln [split $r \n] { + if {[string match "Description:*" $ln]} {set descline $ln} + } + lappend result [string match "Description:*SFIRST*" $descline] + #... while continuations are flush-left with relative indent preserved + #(characterization: the string renderer does not re-indent cmd-help + # continuations under the label - first-vs-rest misalignment by design/wart) + lappend result [markercol $r SFLUSH] + lappend result [expr {[markercol $r SPLUS2] - [markercol $r SFLUSH]}] + }\ + -cleanup { + punk::args::undefine ::testspace::rstring 1 + }\ + -result [list 2 1 0 2] + + #--- P3 -unindentedfields ------------------------------------------------------------ + + test rendering_unindentedfields_arg_help {argument -help with -unindentedfields: left-margin authoring renders aligned with +2 preserved}\ + -setup $common -body { + punk::args::define { + @id -id ::testspace::runind + @cmd -name testspace::runind -summary\ + "Unindented fixture."\ + -help\ + "cmd help." + @values -min 1 -max 1 + v1 -unindentedfields {-help} -help\ +"UFIRST line + UPLUS2 line" + } + set r [render_table ::testspace::runind] + set u0 [markercol $r UFIRST] + lappend result [expr {[markercol $r UPLUS2] - $u0}] + }\ + -cleanup { + punk::args::undefine ::testspace::runind 1 + }\ + -result [list 2] + + test rendering_unindentedfields_cmd_help_GAP {GAP: @cmd accepts -unindentedfields but ignores it - left-margin authored cmd-help misaligns (first line +4 vs continuations)}\ + -setup $common -body { + #the display transform undent(" "+help, max 4) still applies: with + #continuations at the left margin the common prefix is 0, nothing is + #removed, and the first line keeps its injected 4-space prefix. + #(see punk::args arg_error cmd_info handling: '#unindentedfields ?' todo) + punk::args::define { + @id -id ::testspace::rcmdunind + @cmd -name testspace::rcmdunind -summary\ + "Cmd-unindented fixture."\ + -unindentedfields {-help}\ + -help\ +"GFIRST line +GFLUSH line" + @values -min 0 -max 0 + } + set r [render_table ::testspace::rcmdunind] + #pinned CURRENT behaviour: first line renders 4 right of its continuation + lappend result [expr {[markercol $r GFIRST] - [markercol $r GFLUSH]}] + }\ + -cleanup { + punk::args::undefine ::testspace::rcmdunind 1 + }\ + -result [list 4] + + #--- P4 constructed (string-built) definitions ----------------------------------------- + + test rendering_constructed_def_indent_characterization {constructed (string-built) definitions: continuation indentation is absolute - exactly 4 spaces aligns flush; other depths shift (why constructed-def builders must pre-normalize)}\ + -setup $common -body { + #continuations at exactly 4 -> aligned flush with first line (the current + #correct authoring convention for constructed definitions) + set mydef "" + append mydef "@id -id ::testspace::rdyn4" \n + append mydef "@cmd -name testspace::rdyn4 -summary \"Dyn4.\" -help \"DFIRST line\n DFLUSH line\n DPLUS2 line\"" \n + append mydef "@values -min 0 -max 0" + punk::args::define $mydef + set r [render_table ::testspace::rdyn4] + set d0 [markercol $r DFIRST] + lappend result [expr {[markercol $r DFLUSH] - $d0}] + lappend result [expr {[markercol $r DPLUS2] - $d0}] + + #continuations at other depths leak: 8-space source renders +4 right of the + #first line (GAP-ish characterization: no whole-block normalization for + #constructed defs - contrast with the nesting independence of file-style defs) + set mydef "" + append mydef "@id -id ::testspace::rdyn8" \n + append mydef "@cmd -name testspace::rdyn8 -summary \"Dyn8.\" -help \"EFIRST line\n EDEEP line\"" \n + append mydef "@values -min 0 -max 0" + punk::args::define $mydef + set r [render_table ::testspace::rdyn8] + lappend result [expr {[markercol $r EDEEP] - [markercol $r EFIRST]}] + }\ + -cleanup { + punk::args::undefine ::testspace::rdyn4 1 + punk::args::undefine ::testspace::rdyn8 1 + }\ + -result [list 0 2 4] + + #--- choicelabels conventions ---------------------------------------------------------- + + test rendering_choicelabel_one_space_convention {a single-line choicelabel's leading one-space indent (the 'i string is' convention) is preserved relative to its choice name}\ + -setup $common -body { + punk::args::define { + @id -id ::testspace::rlabels + @cmd -name testspace::rlabels -summary\ + "Labels fixture."\ + -help\ + "cmd help." + @values -min 1 -max 1 + mode -choices {LCALPHA LCBETA} -choicelabels { + LCALPHA " LALABEL text" + LCBETA " LBLABEL text" + } -help\ + "arg help." + } + set r [render_table ::testspace::rlabels] + #the label renders one column right of its choice name + lappend result [expr {[markercol $r LALABEL] - [markercol $r LCALPHA]}] + lappend result [expr {[markercol $r LBLABEL] - [markercol $r LCBETA]}] + }\ + -cleanup { + punk::args::undefine ::testspace::rlabels 1 + }\ + -result [list 1 1] + + test rendering_choicelabel_multiline {multiline choicelabels: the documenter's relative indentation is preserved (tclcore 'string is' geometry gives equal columns; a deeper-authored continuation stays deeper by the authored offset)}\ + -setup $common -body { + #MLEQUAL: authored like tclcore's tcl::string::is labels - the quoted value's + #continuation line placed so it lands at the same +1 column as the first line + #(here: definition-block records at 16, first label line effectively at +1 + # after processing, continuation authored at 21 = block indent + 5) + #MLDEEP: continuation deliberately authored 4 deeper than that - the +4 + #relative offset must be preserved, not corrected. + punk::args::define { + @id -id ::testspace::rmlabels + @cmd -name testspace::rmlabels -summary\ + "Multiline labels fixture."\ + -help\ + "cmd help." + @values -min 1 -max 1 + mode -choices {MLEQUAL MLDEEP} -choicelabels { + MLEQUAL\ + " QLA_L1 label line + QLA_L2 label line" + MLDEEP\ + " DLA_L1 label line + DLA_L2 label line" + } -help\ + "arg help." + } + set r [render_table ::testspace::rmlabels] + set n0 [markercol $r MLEQUAL] + lappend result [expr {[markercol $r QLA_L1] - $n0}] + lappend result [expr {[markercol $r QLA_L2] - $n0}] + set n1 [markercol $r MLDEEP] + lappend result [expr {[markercol $r DLA_L1] - $n1}] + lappend result [expr {[markercol $r DLA_L2] - $n1}] + }\ + -cleanup { + punk::args::undefine ::testspace::rmlabels 1 + }\ + -result [list 1 1 1 5] + + #--- P5 multiline tstr ${...} substitutions -------------------------------------------- + + test rendering_tstr_multiline_command_insertion {a ${[command]} returning multiline text inserts aligned at the insertion column with internal relative indents preserved; nesting-independent}\ + -setup $common -body { + proc multitext {} { + return "INS_L1 inserted first\nINS_L2 inserted second\n INS_L3 inserted plus2" + } + punk::args::define { + @id -id ::testspace::rtins + @cmd -name testspace::rtins -summary\ + "Tstr insertion fixture."\ + -help\ + "HFIRST before insertion. + ${[::testspace::multitext]} + HAFTER after insertion." + @values -min 0 -max 0 + } + set r [render_table ::testspace::rtins] + set h0 [markercol $r HFIRST] + lappend result [expr {[markercol $r INS_L1] - $h0}] + lappend result [expr {[markercol $r INS_L2] - $h0}] + lappend result [expr {[markercol $r INS_L3] - $h0}] + lappend result [expr {[markercol $r HAFTER] - $h0}] + #nesting independence with a multiline substitution present (same id redefined + #from a deeper source block - rendering must be identical) + punk::args::undefine ::testspace::rtins 1 + namespace eval nestlevel1 { + namespace eval nestlevel2 { + punk::args::define { + @id -id ::testspace::rtins + @cmd -name testspace::rtins -summary\ + "Tstr insertion fixture."\ + -help\ + "HFIRST before insertion. + ${[::testspace::multitext]} + HAFTER after insertion." + @values -min 0 -max 0 + } + } + } + lappend result [expr {[render_table ::testspace::rtins] eq $r}] + }\ + -cleanup { + punk::args::undefine ::testspace::rtins 1 + rename ::testspace::multitext "" + }\ + -result [list 0 0 2 0 1] + + test rendering_tstr_multiline_var_insertion {a ${$var} with a multiline value inserts aligned at the insertion column}\ + -setup $common -body { + variable RMULTIVAR "VAR_L1 var first\nVAR_L2 var second" + punk::args::define { + @id -id ::testspace::rtvins + @cmd -name testspace::rtvins -summary\ + "Tstr var insertion fixture."\ + -help\ + "VFIRST before. + ${$RMULTIVAR} + VAFTER after." + @values -min 0 -max 0 + } + set r [render_table ::testspace::rtvins] + set v0 [markercol $r VFIRST] + lappend result [expr {[markercol $r VAR_L1] - $v0}] + lappend result [expr {[markercol $r VAR_L2] - $v0}] + lappend result [expr {[markercol $r VAFTER] - $v0}] + }\ + -cleanup { + punk::args::undefine ::testspace::rtvins 1 + }\ + -result [list 0 0 0] + + test rendering_resolved_def_insertion {a ${[punk::args::resolved_def ...]} inserts working definition records: the inherited option renders with its help (+2 preserved) and parses}\ + -setup $common -body { + punk::args::define { + @id -id ::testspace::rdbase + @cmd -name testspace::rdbase -summary\ + "Base def."\ + -help\ + "base help." + @opts + -alpha -default 1 -type boolean -help\ + "RD_L1 alpha help. + RD_L2 alpha help plus2." + @values -min 0 -max 0 + } + punk::args::define { + @id -id ::testspace::rdconsumer + @cmd -name testspace::rdconsumer -summary\ + "Consumer def."\ + -help\ + "consumer help." + @opts + ${[punk::args::resolved_def -types opts ::testspace::rdbase -alpha]} + @values -min 0 -max 0 + } + set r [render_table ::testspace::rdconsumer] + #inherited option present in synopsis and its help text carried over + lappend result [string match "*-alpha*" $r] + set l0 [markercol $r RD_L1] + lappend result [expr {$l0 >= 0}] + lappend result [expr {[markercol $r RD_L2] - $l0}] + #and the inherited option actually parses + set argd [punk::args::parse {-alpha 0} withid ::testspace::rdconsumer] + lappend result [dict get $argd opts] + }\ + -cleanup { + punk::args::undefine ::testspace::rdbase 1 + punk::args::undefine ::testspace::rdconsumer 1 + }\ + -result [list 1 1 2 {-alpha 0}] + + #--- P6 @dynamic double substitution (${$DYN_SOMENAME} idiom) --------------------------- + + test rendering_atdynamic_stability_and_refresh {an @dynamic definition renders identically on repeated resolution, and reflects provider changes in help text, choices display, and parsing}\ + -setup $common -body { + variable rdyn_counter 0 + proc rdyn_help {} { + variable rdyn_counter + return "DYNHELP call$rdyn_counter" + } + proc rdyn_choices {} { + variable rdyn_counter + if {$rdyn_counter == 0} { + return [list redx greenx] + } + return [list redx greenx bluex] + } + variable DYN_RHELP {${[::testspace::rdyn_help]}} + variable DYN_RCHOICES {${[::testspace::rdyn_choices]}} + punk::args::define { + @dynamic + @id -id ::testspace::rdynref + @cmd -name testspace::rdynref -summary\ + "Dyn refresh fixture."\ + -help\ + "${$DYN_RHELP}" + @values -min 1 -max 1 + mode -choices {${$DYN_RCHOICES}} -help\ + "mode help." + } + set r1 [render_table ::testspace::rdynref] + #repeated resolution is stable + lappend result [expr {[render_table ::testspace::rdynref] eq $r1}] + lappend result [string match "*call0*" $r1] + lappend result [string match "*bluex*" $r1] + #restricted choices honour the CURRENT provider output at parse time + if {[catch {punk::args::parse {bluex} withid ::testspace::rdynref}]} { + lappend result bluex-rejected-at-counter0 + } else { + lappend result bluex-UNEXPECTEDLY-accepted + } + #provider changes -> help text, choice display and parse acceptance refresh + set rdyn_counter 1 + set r2 [render_table ::testspace::rdynref] + lappend result [string match "*call1*" $r2] + lappend result [string match "*bluex*" $r2] + set argd [punk::args::parse {bluex} withid ::testspace::rdynref] + lappend result [dict get $argd values] + }\ + -cleanup { + punk::args::undefine ::testspace::rdynref 1 + rename ::testspace::rdyn_help "" + rename ::testspace::rdyn_choices "" + }\ + -result [list 1 1 0 bluex-rejected-at-counter0 1 1 {mode bluex}] + + test rendering_atdynamic_multiline_help_insertion_GAP {GAP: @dynamic double substitution of a MULTILINE result into -help loses insertion-column alignment for lines 2+ (they land 4 left; internal relative indents preserved)}\ + -setup $common -body { + #contrast with rendering_tstr_multiline_command_insertion where single-level + #${[cmd]} insertion aligns all lines at the insertion column. The @dynamic + #second-round substitution (plain subst of the cached parameters) has no + #paramindent re-alignment - a known fragility of the double-substitution + #path, pinned here pending a fix. + proc rdyn_multi {} { + return "YINS_L1 first\nYINS_L2 second\n YINS_L3 plus2" + } + variable DYN_RMULTI {${[::testspace::rdyn_multi]}} + punk::args::define { + @dynamic + @id -id ::testspace::rdynmulti + @cmd -name testspace::rdynmulti -summary\ + "Dyn multiline fixture."\ + -help\ + "YFIRST before insertion. + ${$DYN_RMULTI} + YAFTER after insertion." + @values -min 0 -max 0 + } + set r [render_table ::testspace::rdynmulti] + set y0 [markercol $r YFIRST] + lappend result [expr {[markercol $r YINS_L1] - $y0}] + lappend result [expr {[markercol $r YINS_L2] - $y0}] + lappend result [expr {[markercol $r YINS_L3] - $y0}] + lappend result [expr {[markercol $r YAFTER] - $y0}] + }\ + -cleanup { + punk::args::undefine ::testspace::rdynmulti 1 + rename ::testspace::rdyn_multi "" + }\ + -result [list 0 -4 -2 0] + + test rendering_atdynamic_art_choicelabels {the textblock::frame pattern: @dynamic multiline art choicelabels via ${$DYN_...} with -unindentedfields render byte-aligned}\ + -setup $common -body { + proc rdyn_artlabels {} { + set art_a " ART_TOP+--+\n ART_MID|xx|\n ART_BOT+--+" + return [list arta $art_a artb " plain b label"] + } + variable DYN_RART {${[::testspace::rdyn_artlabels]}} + punk::args::define { + @dynamic + @id -id ::testspace::rdynart + @cmd -name testspace::rdynart -summary\ + "Dyn art labels fixture."\ + -help\ + "cmd help." + @values -min 1 -max 1 + ftype -choices {arta artb} -unindentedfields {-choicelabels} -choicelabels { + ${$DYN_RART} + } -help\ + "ftype help." + } + set r [render_table ::testspace::rdynart] + #all art rows at the same column, one right of the choice name + set n0 [markercol $r arta] + lappend result [expr {[markercol $r ART_TOP] - $n0}] + lappend result [expr {[markercol $r ART_MID] - $n0}] + lappend result [expr {[markercol $r ART_BOT] - $n0}] + }\ + -cleanup { + punk::args::undefine ::testspace::rdynart 1 + rename ::testspace::rdyn_artlabels "" + }\ + -result [list 1 1 1] +} +tcltest::cleanupTests ;#needed to produce test summary line.