diff --git a/CHANGELOG.md b/CHANGELOG.md index e5d32b11..1d8d2f1f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,10 @@ 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.12.31] - 2026-07-14 + +- punk::ns 0.6.0: cmdtrace gains -pause 0 for non-interactive use (bypasses the enter-key pause so the marked-up traced-body report can be captured by scripts/tests). The nested-switch line-mismark was characterized with a punk-free minimal repro (identical on Tcl 8.6.17/8.7a6/9.0.3) confirming the bug upstream (core.tcl-lang.org tktview 5d5b1052280c976ea3d4): arm bodies whose split-list index lands on a literal word of the switch command report container-relative lines; new ns/cmdtrace.test pins correct flat/2-word-form marking and GAP-pins the upstream mismarks; cmdtrace argdoc caveat updated with the ticket and pattern. + ## [0.12.30] - 2026-07-14 - punk::args 0.12.3: fixed the stringstartswith tail-clause reservation bug flagged in the 0.12.2 comment review - the multi-member tail-clause walk in get_dict_can_assign_value compared the prefix against the type string instead of the candidate value, so an optional trailing clause like {literal(with) stringstartswith(v)} lost its matching words to a preceding -multiple argument, and certain prefix spellings caused spurious "Received more values than can be assigned" errors. Characterized pre-fix, pin flipped (allocation.test), guards added for the literal-only and no-match cases. diff --git a/punkproject.toml b/punkproject.toml index e9c3edbb..99921f99 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,4 +1,4 @@ [project] name = "punkshell" -version = "0.12.30" +version = "0.12.31" license = "BSD-2-Clause" diff --git a/scriptlib/developer/tcl_switch_traceline_repro.tcl b/scriptlib/developer/tcl_switch_traceline_repro.tcl new file mode 100644 index 00000000..53810b65 --- /dev/null +++ b/scriptlib/developer/tcl_switch_traceline_repro.tcl @@ -0,0 +1,98 @@ +# tcl_switch_traceline_repro.tcl +# 2026-07-14 Agent-Generated (supporting material for upstream Tcl ticket +# https://core.tcl-lang.org/tcl/tktview/5d5b1052280c976ea3d4 - execution trace on +# nested switch: inconsistent line depending on options) +# +# Pure-Tcl minimal repro - no punkshell code. Run under any tclsh: +# tclsh tcl_switch_traceline_repro.tcl +# Verified byte-identical output pattern on Tcl 8.6.17, 8.7a6 and 9.0.3. +# +# Setup: proc bodies are passed via a variable so they have no source-file line +# correlation (as for interactively defined procs) - enterstep 'info frame' line +# values are then script-relative. Each switch arm body is "{\n \n }", so +# a correctly attributed arm-body command always reports line 2 (arm-relative). +# +# Observed (WRONG marked *): the number of mis-attributed leading arms varies +# with the words of the inner switch command: +# switch $c (3 words): arms 1-5,def -> 2 2 2 2 2 2 +# switch -- $c (4 words): arms -> 3* 3* 2 2 2 2 +# switch -exact -- $c (5 words): arms -> 3* 2 2 2 2 2 +# switch -exact -nocase -- $c (6 words): arms -> 3* 3* 3* 2 2 2 +# +# Empirical law (fits all shapes above plus deeper nestings): an arm body at +# index j of the split pattern/body list is mis-attributed exactly when j lands +# on a LITERAL word of the switch command itself (an option word, --, or the +# block word) - i.e. j < (command word count) and that word is not dynamic. +# The wrong value = arm-relative line + (line of the switch command within its +# containing script - 1): the arm body is treated as if it began at the switch +# command's own line. Dynamic words ($c) and out-of-range j fall back to correct +# arm-relative attribution. Deeper nesting increases the shift accordingly (a +# switch at line 5 of its containing arm script mis-attributes by +4). +# +# The mis-attribution is stable and position-based - NOT call-order based +# (calling arm 3 first still reports arm 3 correctly and arm 1 wrongly later). +# +# Suspected machinery (from reading core-9-1-b1 sources): Tcl_SwitchObjCmd +# (tclCmdMZ.c) passes the split-list index j as the 'word' argument to +# TclNREvalObjEx for the matched body; TclInitCompileEnv (tclCompile.c) then +# gates on (ctxPtr->nline <= word) || (ctxPtr->line[word] < 0) and otherwise +# adopts ctxPtr->line[word] as the compile base line - consistent with j being +# tested against a per-word line array describing the switch COMMAND's words +# rather than the split list elements (the TIP280 munging in Tcl_SwitchObjCmd's +# splitObjs block appears intended to prevent exactly this, so either it is not +# reached on this path or the un-munged frame leaks through another route). + +foreach m {m1 m2 m3 m4 m5 m6} { + proc $m {} [list return $m] +} +set armblock { + 1 { + m1 + } + 2 { + m2 + } + 3 { + m3 + } + 4 { + m4 + } + 5 { + m5 + } + default { + m6 + } + } +foreach {pname header} { + t_w3 {switch $c } + t_w4 {switch -- $c } + t_w5 {switch -exact -- $c } + t_w6 {switch -exact -nocase -- $c } +} { + set body "\n set c \[string index \$s 1\]\n switch -- \[string index \$s 0\] {\n a {\n $header {$armblock}\n }\n default {\n m6\n }\n }\n" + proc ::$pname {s} $body +} + +proc stepper {target args} { + set f [info frame -2] + if {[dict exists $f proc] && [dict get $f proc] eq $target} { + set line NA + catch {set line [dict get $f line]} + lappend ::steps [list [dict get $f type] $line] + } +} +foreach pname {t_w3 t_w4 t_w5 t_w6} { + trace add execution ::$pname enterstep [list stepper ::$pname] + set report {} + foreach input {a1 a2 a3 a4 a5 a9} { + set ::steps {} + ::$pname $input + #last step is the marker command inside the matched innermost arm body + lappend report "arm[string index $input 1]=[lindex $::steps end 1]" + } + trace remove execution ::$pname enterstep [list stepper ::$pname] + puts "$pname (expected arm-relative line 2 for every arm): $report" +} +puts "tcl: [info patchlevel]" diff --git a/src/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index 672aeb7f..fa5aa2ee 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.0.tm @@ -2128,6 +2128,7 @@ y" {return quirkykeyscript} } variable tinfo + variable _cmdtrace_pause 1 ;#gate for the interactive pause in _cmdtrace_leave (cmdtrace -pause option) proc _cmdtrace_enter {vname target args} { variable _cmdtrace_disabled if {$_cmdtrace_disabled} return @@ -2212,8 +2213,11 @@ y" {return quirkykeyscript} } } puts stdout $procbody - punk::lib::askuser "paused - hit enter key to continue" - puts stdout "continuing..." + variable _cmdtrace_pause + if {$_cmdtrace_pause} { + punk::lib::askuser "paused - hit enter key to continue" + puts stdout "continuing..." + } } set _cmdtrace_disabled false @@ -2623,12 +2627,27 @@ y" {return quirkykeyscript} are dubious when *not* referencing source file. (inconsistently based on start-of-switch vs start-of-switcharm script) - Possibly an unreported/unacknowleged - bug in Tcl. + Upstream Tcl bug, reported: + https://core.tcl-lang.org/tcl/tktview/5d5b1052280c976ea3d4 + Observed pattern (8.6/8.7/9.0): an arm body of a + nested single-block switch reports lines shifted by + (line of the switch command within its containing + script - 1) exactly when the arm body's index into + the split pattern/body list lands on a literal word + of the switch command itself (options, --, or the + block); arms whose index lands on a dynamic word or + beyond the command's word count report correctly + arm-relative. See tests ns/cmdtrace.test. " @opts -target -type string -multiple 1 -help\ "" + -pause -type boolean -default 1 -help\ + "Pause (wait for enter key) after each traced proc leave + displays its marked-up body. + Set to false for non-interactive/scripted use so the + trace can run unattended and the final marked-up body + report (the return value) can be captured." -- -type none -help\ "end of options indicator" @values -min 1 -max -1 @@ -2651,6 +2670,9 @@ y" {return quirkykeyscript} set argd [punk::args::parse $args -cache 1 withid ::punk::ns::cmdtrace] lassign [dict values $argd] leaders opts values received + variable _cmdtrace_pause + set _cmdtrace_pause [dict get $opts -pause] + set cmdargs [dict get $values arg] set cinfo [uplevel 1 [list ::punk::ns::cmdinfo {*}$cmdargs]] diff --git a/src/modules/punk/ns-buildversion.txt b/src/modules/punk/ns-buildversion.txt index 63105cfc..64d3b063 100644 --- a/src/modules/punk/ns-buildversion.txt +++ b/src/modules/punk/ns-buildversion.txt @@ -1,6 +1,7 @@ -0.5.0 +0.6.0 #First line must be a semantic version number #all other lines are ignored. +#0.6.0 - cmdtrace gains -pause (default 1 - existing interactive behaviour unchanged): -pause 0 bypasses the 'paused - hit enter key to continue' askuser in _cmdtrace_leave so cmdtrace can run non-interactively/scripted and the returned marked-up body report captured (gate: namespace variable _cmdtrace_pause). cmdtrace argdoc: the nested-switch traced-linenumber caveat now cites the upstream Tcl ticket (core.tcl-lang.org tktview 5d5b1052280c976ea3d4, reported by the developer) and records the characterized pattern (2026-07-14, punk-free minimal repro identical on 8.6.17/8.7a6/9.0.3): a nested single-block switch arm body reports lines shifted by (switch command's line within its containing script - 1) exactly when the arm's index into the split pattern/body list lands on a literal word of the switch command (options/--/block); dynamic-word or out-of-range indices report correctly arm-relative - so which arms mismark varies with the option words used, matching the ticket's observation. New testsuite ns/cmdtrace.test (pause flag, flat-switch and 2-word-nested correct-mark guards, upstream mismark GAP pins gated on have_tclcoredocs since cmdtrace's arm-offset correction needs the ::switch argdoc). #0.5.0 - G-041 doc surface: cmdhelp's -form option defaults to * (was 0) and accepts the punk::args::parse list semantics - the usage display now presents the form the supplied argument words match: the advisory parse_status's matched/best-candidate form's argument table renders at both render sites (alias path and main), with every ranked candidate (noformmatch) or every matching form (multipleformmatches) passed to arg_error so all are marked in the synopsis block ('i after cancel ' presents the cancel form; 'i lseq 0 10 2' presents the range form). punk::ns::synopsis: with trailing argument words after a multiform command path (and no explicit -form), the form(s) the words match are underlined - matching forms from the advisory parse's formstatus, or the best candidate when no form fully matches ('s after cancel someid' marks both cancel forms; 's lseq 0 10 2' marks the range form); ordinal non-comment-line position maps lines to forms in declaration order for both the full and summary renders; skipped when alias currying makes the remaining words unreliable. cmdhelp.test gains the multiform doc-surface pins (autoselected form presented, noformmatch best-candidate table + candidate naming, synopsis marking present/absent). #0.4.0 - G-051: (a) cmdinfo reports cmdtype 'doconly' (was 'notfound') when resolution lands on a punk::args id with no corresponding real command - documentation-only levels such as the per-class id "::tcl::string::is true" below the real ::tcl::string::is, and TclOO documented-method docids like " docmeth" (method case adopts doconly; may be refined by G-052). Consumers audited: cmdhelp/synopsis/eg are docid-driven, cmdtrace only tests for 'proc', punk::lib script analysis updated in step (lib 0.4.1). (b) space-form docid prefix parity: cmd_traverse's space-delimited child docid jump, on an exact-word miss, resolves the word against the current level's choices-bearing first leader via punk::args::choiceword_match (the shared G-040 resolver - -choiceprefix/-nocase/-choicealiases/denylist/reservelist honoured) and retries with the canonical word - so 'i string is tr' resolves to "::tcl::string::is true" exactly when 'string is tr' executes, ambiguous/unknown/denied words stay at the parent exactly when parse rejects them, and resolvedargs records the canonical (as parse normalization does). Tests: the four G-051 GAP pins flipped (cmdhelp_pseudo_command_cmdtype_doconly, cmdhelp_spaceform_docid_prefix_honoured incl ambiguous/unknown guard, cmdhelp_string_is_true_pseudo_doconly, cmdhelp_string_is_prefix_honoured). #0.3.0 - reversal of the G-046-item-5 no-supplied-words suppression (user direction 2026-07-12): cmdhelp's advisory parse failing with NO supplied argument words renders the failure message and error scheme again (both the alias path and the main path; dict returns no longer rewrite the scheme to info), so 'i if'/'i while'/'i foreach' once more signal that the command cannot be called bare - e.g "Bad number of trailing values for if. Got 0 values. Expected at least 2". Rationale: the suppression (ns 0.1.4) existed because the pre-G-049 message was internal-looking ("... for punk::args::parse $args_remaining ..."); the G-049 -caller attribution (ns 0.2.0) made bare-query messages accurate - including the original 'i string is' complaint case, which now reads "Bad number of leading values for string is. Got 0 leaders. Expected exactly 1". Tests: cmdhelp_leader_required_no_args_plain_usage flipped to cmdhelp_leader_required_no_args_error_render; cmdhelp_return_dict_scheme expects scheme error for the bare-query failure. diff --git a/src/tests/modules/AGENTS.md b/src/tests/modules/AGENTS.md index 50e18d3d..bbc8966d 100644 --- a/src/tests/modules/AGENTS.md +++ b/src/tests/modules/AGENTS.md @@ -41,7 +41,7 @@ Unit tests for editable source modules under `src/modules/`, `src/modules_tcl8/` - `punkcheck/` — punkcheck module tests (install, summarize_install_resultdict, installtrack) - `punk/ansi/` — punk::ansi tests (`testsuites/ansi/`): ansistrip/ansimerge, plus characterization of the ANSI-at-position mechanisms (`ansistring.test`: INDEX/INDEXCODE/INDEXCHAR/RANGE/INSERT grapheme indexing with SGR-prefix merging, INDEXCOLUMNS/COLUMNINDEX double-wide column mapping, trim/VIEW), code splitting invariants (`ta.test`: detect/detectcode distinction, split_codes/split_codes_single/split_at_codes shapes and round-trip) and single-code/effective-state semantics (`codetype.test`: is_sgr_reset/has_sgr_leadingreset, has_any/all_effective, sgr_merge, sequence_type classify), grepstr characterization (`grepstr.test`: return modes incl summarydict (linemap pinned as always-present - the -help says -n-only, reconciliation deferred to the planned hygiene pass), exact highlight SGR wrapping, -n line numbering, invert + empty-highlight strip, -C context/breaks, capture groups, and the tab deficiency: warns once per call on stderr, single-pass tab line survives - the multi-pass mangling is pinned at consumer level in punk/ns corp.test), and untabify characterization (`untabify.test`: -stops int/list/terminal, -with spaces/unicode/custom-pair, multiline, errors, plus the EXPERIMENTAL -plastic elastic-tabstop mode deliberately pinned-as-interim and retained for possible repl editbuf use). Console queries (get_tabstops/get_size + punk::console::tabwidth) are mocked per the overtype renderline.test pattern - they emit live terminal queries that block/error headless. ANSI codes in these tests are literal escape strings so results are colour-state independent - `punk/args/` — punk::args tests (`testsuites/args/`): parsing, choices/choicegroups, forms, rendering/indentation characterization, synopsis display characterization (`synopsis.test`: basic italic argname/`` styling, longopt `--x=` alias forms, literal/literalprefix/stringstartswith/stringendswith type-alternates rendering unitalicised, option alternate parenthesization, multi-element clause display incl `?type?` members and argname tail-word hints, `-typesynopsis` value-element lists and option passthrough incl documenter ANSI, and the small-restricted-choice-set literal rule: 1-3 restricted choices render as unitalicised `|`-joined literals in leader/option/value positions with choicegroups counted, >3 or `-choicerestricted 0` falling back to italics, `-typesynopsis` taking precedence), usage-marking characterization (`usagemarking.test`: -parsedargs/-badarg/-parsestatus/-scheme marking primitives plus goodchoice highlighting of selected/default-in-effect choice words, asserted by SGR-parameter subset against the live colour arrays; the G-049 nocolour/colour-leak GAP pins flipped 2026-07-10 to scheme-statelessness assertions), the G-049 parse-status structure (`parsestatus.test`: punk::args::parse_status overall/per-argument statuses, badarg for type/allocation failures, -caller attribution, errorcode -argspecs stripping), -parsekey characterization (`parsekey.test`: result/received/solos/multis keying, shared-key required satisfaction and defaults, mash-path and prefix-abbreviation keying, plus GAP pins for last-defined-member default precedence, cross-member -multiple value loss, parsekey/optname collision conflation, and values/leaders parsekey breakage - desired-behaviour pins disabled behind punkargsKnownBug in `testsuites/dev/parsekey-knownbugs.test`), and tclcore doc/interpreter behavioural parity (`tclcoreparity.test`, G-054, gated on have_tclcoredocs: 'string is' class choices equal the live-harvested set, per-class docids exist, error-vs-ok agreement across the probe matrix, version-note labels conditional on class presence - expectations derived from the running interpreter, green on 8.6/8.7/9.0; under 8.6 run the file directly via a plain tclkit + tcltest driver since runtests' harness needs newer infrastructure) -- `punk/ns/` — punk::ns tests (`testsuites/ns/`): cmdwhich/cmdinfo/cmd_traverse doc-lookup flow (`cmdflow.test`, G-040 parity), corp proc-retrieval and syntax/untabify interplay (`corp.test`: name edge cases, -ranges/-n line handling, basic-highlight ansistrip equivalence, -untabify spaces/unicode tab-free output, the KNOWN-DEFICIENCY pin for default -untabify none on tabbed bodies - grepstr warns per pass and brace overlays mangle tabbed lines, deterministic under mocked console tabstops - and a ::tcl::CopyDirectory -untabify spaces smoke test; precursor coverage for the planned punk::ns hygiene pass), and cmdhelp usage-rendering integration (`cmdhelp.test`: scheme selection, goodarg/badarg marking incl type/allocation failures, goodchoice highlighting of supplied/default choice words, alias path, cmdinfo result shape, queried-command failure attribution, and `-return dict` parse-status returns (G-049 - its GAP pins flipped 2026-07-10); remaining GAP pins for pseudo-command cmdtype + space-form docid prefixes (G-051, real `string is` pins behind the have_tclcoredocs constraint), TclOO undocumented-method fallback (G-052), and synopsis marking absence (G-050)) +- `punk/ns/` — punk::ns tests (`testsuites/ns/`): cmdwhich/cmdinfo/cmd_traverse doc-lookup flow (`cmdflow.test`, G-040 parity), corp proc-retrieval and syntax/untabify interplay (`corp.test`: name edge cases, -ranges/-n line handling, basic-highlight ansistrip equivalence, -untabify spaces/unicode tab-free output, the KNOWN-DEFICIENCY pin for default -untabify none on tabbed bodies - grepstr warns per pass and brace overlays mangle tabbed lines, deterministic under mocked console tabstops - and a ::tcl::CopyDirectory -untabify spaces smoke test; precursor coverage for the planned punk::ns hygiene pass), cmdtrace characterization (`cmdtrace.test`: -pause 0 non-interactive runs, linedict line-mark keys for flat and 2-word-form nested switches as correct-mark guards, and GAP pins for the upstream nested-switch mismark - core.tcl-lang.org tktview 5d5b1052280c976ea3d4, arm bodies whose split-list index lands on a literal switch-command word report container-relative lines; mark tests gated on have_tclcoredocs because cmdtrace's arm-offset correction parses against the ::switch argdoc), and cmdhelp usage-rendering integration (`cmdhelp.test`: scheme selection, goodarg/badarg marking incl type/allocation failures, goodchoice highlighting of supplied/default choice words, alias path, cmdinfo result shape, queried-command failure attribution, and `-return dict` parse-status returns (G-049 - its GAP pins flipped 2026-07-10); remaining GAP pins for pseudo-command cmdtype + space-form docid prefixes (G-051, real `string is` pins behind the have_tclcoredocs constraint), TclOO undocumented-method fallback (G-052), and synopsis marking absence (G-050)) - `punk/mix/` — punk::mix::cli tests (prune helpers, punkcheck virtual sources), punk::mix::commandset::repo fossil move/rename characterization tests (`testsuites/repo/`, FOSSIL_HOME-isolated; GAP-marked tests pin behaviour G-022 will change), punk::mix::commandset::loadedlib tests (`testsuites/loadedlib/libsearch.test`: 'dev lib.search' match semantics via -return list — wrap-glob default, =exact prefix, case rules, explicit globs, version aggregation — plus the loadedlib 0.2.0 contract: deep discovery by default (deep .tm modules found without -refresh, registration persists), -refresh = genuine re-scan (epoch incr + rediscovery picks up .tm files added to already-scanned dirs), and highlight working without the shell-global a+ alias; shared provisioned child interp sourcing the source-tree libunknown directly — see the file's ORDERING NOTE), and the MULTISHELL polyglot build machinery (`testsuites/scriptwrap/multishell.test`: scriptset wrap via the punk.multishell.cmd template - structure/LF-only/determinism, checkfile 512-byte label validation of fresh wraps AND the committed bin/runtime.cmd, the runtime scriptset round-trip byte-identity pin, and platform-gated execution smoke: cmd.exe→powershell payload on windows, sh payload on unix or via the `wsllinux` capability constraint from `src/tests/testsupport/wslprobe.tcl` - staged to the WSL distro's native filesystem, G-059) - `punk/lib/` — punk::lib tests (`testsuites/lib/`): range/index/parse/compat/interp_sync utilities, G-058 static-baseline seeding (`staticseed.test`: interp_sync_package_paths/snapshot_package_paths propagate a simulated ::punkboot static baseline and seed `load {} ` ifneeded mappings; no-op without a baseline), and the repl command-completeness engine (`commandcomplete.test`: punk::lib::system::incomplete pending-opener stacks - the info-complete quoting quirk progression (`set x "{*}{"` standalone vs in-proc-body), single openers, tabs, escapes, incomplete<->info-complete parity property; pre-repl-refactor characterization, see goals/G-044 detail preserve-list) - `punk/packagepreference/` — punk::packagepreference tests (`testsuites/packagepreference/`): G-058 static-vs-bundled policy (`staticpolicy.test`: require of a baseline package triggers the index scan before resolution so a newer bundled copy wins, static beats older bundled, exact requires of bundled versions stay reachable, missing static mappings get seeded) diff --git a/src/tests/modules/punk/ns/testsuites/ns/cmdtrace.test b/src/tests/modules/punk/ns/testsuites/ns/cmdtrace.test new file mode 100644 index 00000000..6f4a6e50 --- /dev/null +++ b/src/tests/modules/punk/ns/testsuites/ns/cmdtrace.test @@ -0,0 +1,167 @@ +package require tcltest + +package require punk::ns +package require punk::console + +#added 2026-07-14 (agent) - punk::ns::cmdtrace characterization (still-primitive +#debug utility - traces a proc and returns its corp -n body with traversed lines +#red/underline highlighted; possible future hotspot-analysis use). +# +#The new -pause 0 option makes cmdtrace runnable non-interactively (bypasses the +#'paused - hit enter key to continue' askuser in _cmdtrace_leave) - these tests +#depend on it. +# +#Line-mark assertions are keyed on the machine-readable marking data +#(::punk::ns::linedict lines - a dict of corp -n line number -> type/calls) +#rather than parsing the ANSI-marked body. Only the line-number KEYS are pinned: +#call counts conflate ensemble double-callbacks (see _cmdtrace_enterstep notes) +#and are not part of the contract being characterized. +# +#cmdtrace's switch-arm offset correction parses supplied switch commands against +#the ::switch argdoc from punk::args::moduledoc::tclcore - without it every arm +#falls back to eval_offset 1 and marks are uniformly wrong. All mark tests are +#therefore gated on have_tclcoredocs (tclcoreparity.test convention). +# +#UPSTREAM Tcl bug (reported by the user: +#https://core.tcl-lang.org/tcl/tktview/5d5b1052280c976ea3d4): +#for procs without source-line correlation, an arm body of a NESTED single-block +#switch reports enterstep 'line' values shifted by (line of the switch command +#within its containing script - 1) exactly when the arm body's index into the +#split pattern/body list lands on a literal word of the switch command (options, +#--, or the block itself); arms whose index lands on a dynamic word or beyond the +#command's word count report correctly arm-relative. Verified byte-identical on +#Tcl 8.6.17 / 8.7a6 / 9.0.3 with a punk-free minimal repro (2026-07-14). +#The _GAP-marked pins below encode the resulting mismarks; flip them if Tcl fixes +#the attribution (or cmdtrace works around it). +namespace eval ::testspace { + namespace import ::tcltest::* + + testConstraint have_tclcoredocs [expr {![catch {package require punk::args::moduledoc::tclcore}]}] + + proc mock_console {} { + if {[llength [info commands ::punk::console::get_tabstops]]} { + rename ::punk::console::get_tabstops ::testspace::__orig_get_tabstops + } + proc ::punk::console::get_tabstops {{inoutchannels {stdin stdout}}} { + set stops {} + for {set c 9} {$c <= 201} {incr c 8} {lappend stops $c} + return $stops + } + if {[llength [info commands ::punk::console::get_size]]} { + rename ::punk::console::get_size ::testspace::__orig_get_size + } + proc ::punk::console::get_size {args} { + return [dict create columns 80 rows 24] + } + } + proc restore_console {} { + catch {rename ::punk::console::get_tabstops {}} + if {[llength [info commands ::testspace::__orig_get_tabstops]]} { + rename ::testspace::__orig_get_tabstops ::punk::console::get_tabstops + } + catch {rename ::punk::console::get_size {}} + if {[llength [info commands ::testspace::__orig_get_size]]} { + rename ::testspace::__orig_get_size ::punk::console::get_size + } + } + variable csetup { + set result "" + ::testspace::mock_console + } + variable ccleanup { + ::testspace::restore_console + } + #run cmdtrace -pause 0 and return the sorted marked line numbers for the target + proc marked_lines {target args} { + punk::ns::cmdtrace -pause 0 $target {*}$args + return [lsort -integer [dict keys [dict get $::punk::ns::linedict ::$target lines]]] + } + + + test cmdtrace_pause_flag_noninteractive {-pause 0 runs unattended and returns the marked-up report}\ + -setup $csetup -body { + set display [punk::ns::cmdtrace -pause 0 punk::ns::test_switch5 x] + lappend result [string match "*success_calls: 1*" $display] + lappend result [string match "*error_calls : 0*" $display] + }\ + -cleanup $ccleanup\ + -result [list\ + 1 1 + ] + + test cmdtrace_marks_flat_switch {flat single-block switch: every arm's body line marks correctly (corp -n numbering)}\ + -constraints have_tclcoredocs\ + -setup $csetup -body { + #test_switch5: set ch1@2, switch@3, arm returns at 5,8,11,14,17,20 + foreach input {x y z a b _} { + lappend result [marked_lines punk::ns::test_switch5 $input] + } + set result + }\ + -cleanup $ccleanup\ + -result [list\ + {2 3 5}\ + {2 3 8}\ + {2 3 11}\ + {2 3 14}\ + {2 3 17}\ + {2 3 20} + ] + + test cmdtrace_marks_nested_2word_guard {nested switch in 2-word form (switch $var {block}): all arms mark correctly}\ + -constraints have_tclcoredocs\ + -setup $csetup -body { + #test_switch4 inner switch uses the 2-word form (switch \$ch2 ) - + #the arm-body list indices land on a + #dynamic word or out of range, so the upstream mis-attribution cannot + #trigger: outer switch@2, set ch2@4, inner switch@5, then per-arm + #call_frame/return pairs at 7/8 (x) and 11/12 (y) + lappend result [marked_lines punk::ns::test_switch4 ax] + lappend result [marked_lines punk::ns::test_switch4 ay] + }\ + -cleanup $ccleanup\ + -result [list\ + {2 4 5 7 8}\ + {2 4 5 11 12} + ] + + test cmdtrace_marks_nested_upstream_mismark_GAP {GAP (upstream tcl tktview 5d5b1052280c976ea3d4): first arms of a nested 'switch -- [cmd]' mismark by +1}\ + -constraints have_tclcoredocs\ + -setup $csetup -body { + #test_switch2 inner switch (switch -- \[string index \$s 1\] ) is the 4-word shape: + #arm-body list indices 1 and 3 land on the literal '--' and block words of + #the switch command, so arms 1 and 2 report container-relative (+1 here - + #the inner switch is at line 2 of its containing arm script). + #Correct marks would be: + # a1 -> {2 4 6} (return a1@6) - marked 7 + # a2 -> {2 4 11 12} (set msg@11 return@12) - marked 12 13 + #The innermost default arm (a3x) is beyond the affected indices and marks + #correctly ({2 4 15 16 24}: set slen@15, innermost switch@16, return@24). + lappend result [marked_lines punk::ns::test_switch2 a1] + lappend result [marked_lines punk::ns::test_switch2 a2] + lappend result [marked_lines punk::ns::test_switch2 a3x] + }\ + -cleanup $ccleanup\ + -result [list\ + {2 4 7}\ + {2 4 12 13}\ + {2 4 15 16 24} + ] + + test cmdtrace_marks_error_call {a traced call that raises still reports and counts the error}\ + -setup $csetup -body { + proc ::testspace::boom {x} { + error "boom-$x" + } + set display [punk::ns::cmdtrace -pause 0 ::testspace::boom 1] + lappend result [string match "*error_calls : 1*" $display] + }\ + -cleanup { + rename ::testspace::boom "" + ::testspace::restore_console + }\ + -result [list\ + 1 + ] +} +tcltest::cleanupTests ;#needed to produce test summary.