From bfc2d44393d7ae075b8c821fca57f842db7528e8 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Sun, 2 Aug 2026 06:44:30 +1000 Subject: [PATCH] G-070 increment 3: punk::lib dispatch + suites; three-runtime verification punk::lib 0.6.0: tclparser_tcl stub replaced by delegation to punk::tclparser; new tclparser_prefer (memoized auto c|tcl dispatch via namespace-local parse aliases, forcible); tclscript_info and tclword_to_scriptlist route through it; a+ -using debug puts commented out (crashed plain tclsh); tclword_to_scriptlist PUNKARGS argdoc added. New suites: tclparser_engine.test (20 oracle-verified pins + dispatch, runs everywhere) and tclparser_parity.test (77-case recorded corpus + range-walk + entry-point parity, capability-gated, oracle dir via PUNK_TCLPARSER_ORACLE_DIR). 23/23 under tclsh 8.7a6 and 9.0.3; lib subtree green (8.7 compat.test lpop failure proven pre-existing). Real 8.6.13 (punksys kit): corpus parity clean; \xHH model corrected - TIP 388 2-hex cap holds on 8.6 too, version-conditional removed from the engine. Plain-tclsh fallback demo green both gens (auto_path cleared): prefer->tcl, tclword_to_scriptlist correct incl nested array-index command substitutions, output identical to the c path. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- goals/G-070-pure-tcl-tclparser.md | 81 +++++++ src/modules/punk/lib-999999.0a1.0.tm | 164 +++++++++++--- src/modules/punk/lib-buildversion.txt | 3 +- src/modules/punk/tclparser-999999.0a1.0.tm | 19 +- .../lib/testsuites/lib/tclparser_engine.test | 174 +++++++++++++++ .../lib/testsuites/lib/tclparser_parity.test | 205 ++++++++++++++++++ 6 files changed, 605 insertions(+), 41 deletions(-) create mode 100644 src/tests/modules/punk/lib/testsuites/lib/tclparser_engine.test create mode 100644 src/tests/modules/punk/lib/testsuites/lib/tclparser_parity.test diff --git a/goals/G-070-pure-tcl-tclparser.md b/goals/G-070-pure-tcl-tclparser.md index 6f9eb9f5..620c7c8b 100644 --- a/goals/G-070-pure-tcl-tclparser.md +++ b/goals/G-070-pure-tcl-tclparser.md @@ -175,6 +175,87 @@ shim + tclparser_tcl replacement), capability-gated tcltest parity suite + pure-Tcl fallback suite (port of the harness corpus), plain-tclsh tclword_to_scriptlist demonstration, real-8.6 verification, reference identity recording. +[all resolved in increment 3 below] + +### Increment 3 (2026-08-02): dispatch wiring, test suites, three-runtime verification + +punk::lib 0.6.0: + +- tclparser_tcl error stub REPLACED by a working delegation to + punk::tclparser::parse (same {subcmd string range} signature). +- New punk::lib::tclparser_prefer (PUNKARGS-documented): automatic memoized + dispatch - 'package require parser' succeeding means the c library serves + the global ::parse the analysis procs call (preferred, performance); + otherwise namespace-local 'parse' aliases (::punk::lib::parse and + ::punk::lib::tclscript_info::parse) route every existing bare 'parse ...' + call site to the pure-Tcl engine with zero body edits. Optional argument + forces c|tcl (testing/benchmarks); forcing c removes the aliases. +- tclscript_info's hard 'package require parser' and tclword_to_scriptlist's + dispatch now go through tclparser_prefer; the 'may be less accurate' + fallback warning removed (no longer true). tclword_to_scriptlist gained a + PUNKARGS argdoc (the acceptance's documented entry point) and its three + active debug puts were commented out - two used the repl-only a+ alias and + crashed any plain tclsh exercising the variable-subnode path (found by the + acceptance demo, which exists to catch exactly this). + +Test suites (src/tests/modules/punk/lib/testsuites/lib/): + +- tclparser_engine.test (20 tests, runs everywhere, no c library needed): + engine result-shape pins - all values oracle-verified during increments + 2-3 - covering the 4-tuple, byte ranges (multibyte), simple/word/expand + nodes, literal-expansion, restRange walking, nested array-variable + subnodes, getstring/countnewline, error messages, the uncovered-subcommand + error, the no-package-'parser' guarantee, plus the punk::lib dispatch: + forced-tcl tclword_to_scriptlist results and tclparser_tcl delegation. +- tclparser_parity.test (capability-gated on 'package require parser', with + env PUNK_TCLPARSER_ORACLE_DIR appended to auto_path first so the fork's + built dlls can supply the oracle on binary-less runners): the RECORDED + PROBE CORPUS (77 labelled cases: quoting, {*} expansion incl literal/ + complex/separator forms, comments incl backslash-continuation, backslash + escapes incl word-separator backslash-newline, nested command + substitution, variables incl generation-sensitive forms, multibyte, + terminators, error cases, plus representative punkshell-style source + snippets) compared c-vs-pure over both range forms; a + getstring/countnewline walk over every range in every corpus parse tree; + and entry-point parity (tclword_to_scriptlist forced-c vs forced-tcl). + +Verification (all green): + +- runtests modules/punk/lib/*** : Tcl 9.0.3 66/67 pass (1 unrelated skip), + Tcl 8.7a6 66/67 with the single compat.test lpop-matrix failure PROVEN + pre-existing (fails identically with the pristine punk::lib under 8.7a6 - + this box's known-baseline class, not a G-070 regression). New suites 23/23 + under both, parity constraint satisfied natively (magicsplat tclsh90 + ships tclparser 1.9 - an INDEPENDENT c build also passing parity) and via + PUNK_TCLPARSER_ORACLE_DIR under 8.7. +- Real Tcl 8.6.13 (punksys kit, scratch copy, 'script' subcommand): dev + corpus harness PARITY CLEAN (234 comparisons + 989 getstring/countnewline) + against the tcl86-gen fork oracle dll. Model correction from this run: + \xHH consumes at most 2 hex digits on 8.6 TOO (TIP 388 is in since 8.6; + unlimited \x is Tcl 8.5) - the increment-2 version-conditional was + removed, the cap is now unconditional. +- Plain-tclsh acceptance demo (auto_path cleared so no parser binary is on + the package path; punk modules via tm path): Tcl 9.0.3 and 8.7a6 - + 'parser package available: 0', tclparser_prefer -> tcl, + tclword_to_scriptlist returns correct scriptlists including nested + array-index command substitutions; identical output with the c library + enabled (prefer -> c). +- make.tcl modules clean. + +Reference source consulted (per Acceptance): the tclparser_punk fork repo +(gitea jn/tclparser, working copy c:/repo/jn/tclparser_punk) at commit pin +16d2f460b89dfd819aa08ceb97dfebf37b9fa55a - its zig-built parser dlls +(zig-out/lib//win32-x86_64/parser1.9/) are the c oracle all parity +evidence compares against, and its src/reference provenance table pins the +upstream snapshots consulted: aspect chiselapp fossil checkin +53f5b44b14bdbdf4b7a3a1b02ba40425e145d76b (tclparser 1.4.1 lineage, +2015-06-18) and tcltk-depot git commit +c6c841d6c4c03fe19b45279dd29266db7861fdb3 (parser 1.9 Tcl 9 port baseline, +2025-07-29). + +Covered set (final): parse command (ranges {} and {0 end} plus general +{first len|end}), parse getstring, parse countnewline. Uncovered (error +advising the c library): expr, varname, list, charindex, charlength. ## Notes diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index cc6245fa..78c8896f 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -2519,7 +2519,7 @@ namespace eval punk::lib { #for each of the above strings we should get a command recognised for the 'puts e*' items as well as the 'list' item, but not for the 'puts n' items since they are within curly braces and not subject to command substitution. #--------------------------------- proc tclscript_info {script {nscontext ""}} { - package require parser + tclparser_prefer ;#c library preferred, punk::tclparser pure-Tcl fallback wired otherwise (G-070) #if the script is ANSI highlighted - the square brackets within the ANSI will disrupt our parsing. if {[punk::ansi::ta::detect $script]} { #we will strip it - but be noisy on stderr since a) it's a bi inefficient to pass in ansi highlighted scripts. @@ -3555,27 +3555,107 @@ namespace eval punk::lib { } return $resultd } + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punk::lib::tclparser_prefer + @cmd -name punk::lib::tclparser_prefer\ + -summary\ + "Resolve which tclparser implementation serves punk::lib's script analysis."\ + -help\ + "Resolve which tclparser implementation serves punk::lib's + script-analysis procs (tclscript_info and the + tclscript_info::* helpers), returning 'c' or 'tcl'. + + With no argument the decision is automatic and memoized for + the process: the tclparser c library is preferred when + 'package require parser' succeeds (it provides the global + ::parse command the analysis procs call); otherwise the + punk::tclparser pure-Tcl engine (G-070, parity-tested + against the c library) is wired in as namespace-local + 'parse' aliases so the same call sites fall back with no + body changes. A c library loaded later is not consulted + once the fallback is wired. + + With the optional argument the preference is forced: 'c' + requires the c library (error if unavailable) and removes + any fallback aliases; 'tcl' wires the pure-Tcl engine even + when the c library is present (testing/benchmarks)." + @values -min 0 -max 1 + which -type string -choices {c tcl} -optional 1 -help\ + "Force the preference instead of deciding automatically" + }] + } + proc tclparser_prefer {args} { + #manual parsing - see PUNKARGS documentation above + variable tclparser_which + if {[llength $args] > 1} { + error "wrong # args: should be \"punk::lib::tclparser_prefer ?c|tcl?\"" + } + if {[llength $args] == 1} { + set want [lindex $args 0] + switch -exact -- $want { + c { + package require parser + catch {interp alias {} ::punk::lib::parse {}} + catch {interp alias {} ::punk::lib::tclscript_info::parse {}} + set tclparser_which c + } + tcl { + package require punk::tclparser + interp alias {} ::punk::lib::parse {} ::punk::tclparser::parse + interp alias {} ::punk::lib::tclscript_info::parse {} ::punk::tclparser::parse + set tclparser_which tcl + } + default { + error "punk::lib::tclparser_prefer: unknown preference '$want' - must be c or tcl" + } + } + return $tclparser_which + } + if {[info exists tclparser_which]} { + return $tclparser_which + } + if {![catch {package require parser}]} { + set tclparser_which c + } else { + package require punk::tclparser + interp alias {} ::punk::lib::parse {} ::punk::tclparser::parse + interp alias {} ::punk::lib::tclscript_info::parse {} ::punk::tclparser::parse + set tclparser_which tcl + } + return $tclparser_which + } + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punk::lib::tclparser_tcl + @cmd -name punk::lib::tclparser_tcl\ + -summary\ + "Pure-Tcl 'parse' with the same API as the tclparser c library."\ + -help\ + "Pure-Tcl implementation of the tclparser c library's 'parse' + command API (G-070) - a thin delegation to + punk::tclparser::parse, which covers the subcommands + punkshell consumes (command, getstring, countnewline) with + parity-tested result shapes and byte ranges. The c library + remains preferred where present - see tclparser_prefer." + @values -min 3 -max 3 + subcmd -type string -help\ + "parse subcommand (covered set: command, getstring, countnewline)" + string -type string -help\ + "the string to operate on" + range -type list -help\ + "byte range {start length} - {} means the whole string" + }] + } proc tclparser_tcl {subcmd string range} { - #provide a tcl parser with the same API as the tclparser c library. + #pure-Tcl fallback for the tclparser c library (G-070). + #Historical upstream references (now vendored/pinned in the + #punkshell-maintained fork c:/repo/jn/tclparser_punk - see + #goals/G-070-pure-tcl-tclparser.md): #https://chiselapp.com/user/aspect/repository/tclparser/index - #or - #https://github.com/ActiveState/teapot/tree/master/lib/tclparser - - set scriptlist [list] - set argchars [split $string ""] - set in_dq 0 ;#in double quotes - set in_cb 0 ;#in curly braces - set in_commandsub 0 ;#in command substitution (i.e within square brackets) - #when we are in a command substitution - we should be able to keep appending whilst testing for info complete. review - set escaped 0 - set nesting_level 0 - set scripttoken "" - for {set i 0} {$i < [llength $argchars]} {incr i} { - set ch [lindex $argchars $i] - #todo - error "tclparser_tcl not yet implemented - in the meantime install the tclparser c library (package require parser)" - } - + #https://github.com/tcltk-depot/tcl-parser + package require punk::tclparser + tailcall ::punk::tclparser::parse $subcmd $string $range } namespace eval tclscript_info { @@ -3671,7 +3751,39 @@ namespace eval punk::lib { #- commonly just a variable e.g 'set cmdname foo; $cmdname arg1 arg2' # but it could also have command subtitutions e.g 'cmdname_[get_suffix] arg1 arg2' + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punk::lib::tclscript_info::tclword_to_scriptlist + @cmd -name punk::lib::tclscript_info::tclword_to_scriptlist\ + -summary\ + "List the toplevel command substitutions within a single tcl word."\ + -help\ + "Analyse a string representing a single tcl word (a bareword, + double quoted string or curly braced string as it appears in + source - possibly spanning multiple lines) and return the list + of toplevel commands that would be substituted into it, in + order of evaluation. Each element is itself a command list. + A fully brace-quoted word is opaque and returns an empty list. + Command substitutions nested within array-variable indexes are + included; commands nested within OTHER commands' substitutions + are not (this proc is deliberately non-recursive - see + tclscript_info for the recursive analysis). + + Parsing uses the tclparser c library when available, else the + punk::tclparser pure-Tcl engine (G-070) - see + punk::lib::tclparser_prefer. Works under a plain tclsh with no + parser binary on the package path." + @leaders + string -type string -help\ + "the tcl word to analyse" + @values -min 0 -max 1 + nscontext -type string -optional 1 -help\ + "namespace context for the analysis (defaults to the caller's + current namespace)" + }] + } proc tclword_to_scriptlist {string {nscontext ""}} { + #manual args (simple positional signature) - see PUNKARGS documentation above #consider 'list [puts a]$v(x,[puts b])[puts c]' # the command substitutions are [puts a], [puts b] and [puts c] #The order of evaluation is [puts a] then [puts b] then [puts c] but [puts b] is within the variable array syntax and so parses differently to the other two command substitutions. @@ -3680,7 +3792,7 @@ namespace eval punk::lib { if {$nscontext eq ""} { set nscontext [uplevel 1 {namespace current}] } - puts stderr "------------tclword_to_scriptlist called with string: $string nscontext: $nscontext------------" + #puts stderr "------------tclword_to_scriptlist called with string: $string nscontext: $nscontext------------" #analyse a string that will undergo command substitution to determine the list of commands that will be substituted into the string. #e.g for "a string with [puts hello] and [puts world]" we would return a list of 2 items, each being a list of the command and its arguments, e.g {puts hello} and {puts world} #we need to do a full parse of the string to determine which square brackets are actually command substitutions that need to be analysed for complexity, and which are just literal characters within the string. @@ -3697,11 +3809,11 @@ namespace eval punk::lib { set scriptlist [list] - if {![catch {package require parser}]} { - #use tclparser library if available + if {[punk::lib::tclparser_prefer] eq "c"} { + #tclparser c library (preferred where present - performance) set parseinfo [::parse command $boguscmdline {0 end}] } else { - puts stderr "tclparser library not available - using fallback tcl parser which may be less accurate - review" + #punk::tclparser pure-Tcl engine (G-070) - parity-tested against the c library set parseinfo [::punk::lib::tclparser_tcl command $boguscmdline {0 end}] } #returns 4 items. @@ -3780,7 +3892,7 @@ namespace eval punk::lib { #set var_subscript_cmds [punk::lib::tclscript_info::tclword_to_scriptlist $varstringfull $nscontext] set varsubnodes [lindex $subnode 2] foreach varsubnode $varsubnodes { - puts stderr "[a+ cyan]varsubnodes: $varsubnodes type: [lindex $varsubnode 0][a]" + #puts stderr "varsubnodes: $varsubnodes type: [lindex $varsubnode 0]" if {[lindex $varsubnode 0] eq "command"} { set pos_bytes [lindex $varsubnode 1] set cmdstringfull [parse getstring $boguscmdline $pos_bytes] ;#this must be used instead of string range to correctly handle any multibyte characters in the original string @@ -3796,7 +3908,7 @@ namespace eval punk::lib { } elseif {[lindex $varsubnode 0] eq "variable"} { set pos_bytes [lindex $varsubnode 1] set varstringfull [parse getstring $boguscmdline $pos_bytes] - puts stderr "[a+ cyan]varstringfull: $varstringfull[a]" + #puts stderr "varstringfull: $varstringfull" set varscriptlist [punk::lib::tclscript_info::tclword_to_scriptlist $varstringfull $nscontext] lappend scriptlist {*}$varscriptlist } diff --git a/src/modules/punk/lib-buildversion.txt b/src/modules/punk/lib-buildversion.txt index b8c15f8c..50b2df4e 100644 --- a/src/modules/punk/lib-buildversion.txt +++ b/src/modules/punk/lib-buildversion.txt @@ -1,6 +1,7 @@ -0.5.1 +0.6.0 #First line must be a semantic version number #all other lines are ignored. +#0.6.0 - G-070: script-analysis paths no longer require the tclparser c binary. New punk::lib::tclparser_prefer (auto/forced c|tcl dispatch, memoized; wires namespace-local 'parse' aliases to the punk::tclparser pure-Tcl engine when the c library is absent); tclparser_tcl error stub replaced by a working delegation to punk::tclparser::parse; tclscript_info's hard 'package require parser' and tclword_to_scriptlist's dispatch now go through tclparser_prefer (the 'less accurate' fallback warning removed - the engine is parity-tested against the c library, ~50k command-parses per generation clean). #0.5.1 - compat::lpop builtin-parity fixes (validated by a 24-case differential matrix vs the 8.7/9 builtin, pinned in modules/punk/lib compat.test): out-of-range errors now use the builtin's message ('index "X" out of range' - was 'tcl_lpop index ...') and errorcode {TCL VALUE INDEX OUTOFRANGE}; variable-access failures (unset var / whole-array name / missing array element) reproduce the builtin's exact message and errorcode by probing with a plain read in the caller's frame BEFORE creating the upvar link (through a link, or once a link exists, Tcl flattens the detail - 'no such variable' loses its TCL LOOKUP errorcode and a missing array element misreports as 'no such variable'). No success-path changes. Doc note corrected: 8.6's core index parser already accepts TIP-176 M+N arithmetic, so compat::lpop has no known divergence from the builtin. #0.5.0 - G-076: check::tclbug_console_deadspin_fixed_in set to 9.0.5 - the upstream f10d91c2d3 fix (ticket closed 2026-07-14, merged to core-9-0-branch whose head reports 9.0.5) passed the G-039 kill-procedure re-verification 2026-07-20 on a zig-built core-9-0-branch runtime with the watchdog disarmed (dead console delivered as a readable fileevent; repl exited via the eof path - needs punk::repl 0.5.2's repl_handler guard). Runtimes at or past 9.0.5 now neither warn via 'help tcl' nor arm the repl watchdog; earlier Tcl 9 windows runtimes keep both. Official release not required per the amended G-076 acceptance (self-built from upstream sources qualifies). #0.5.0 - new check pair punk::lib::check::has_tclbug_nestedswitch_tracelines + tclbug_nestedswitch_tracelines_signature (pure facts-in/verdict-out classifier, G-076 console_deadspin style): live behavioural probe of upstream tcl tktview 5d5b1052280c976ea3d4 (execution-trace line mis-attribution for nested single-block switch arm bodies whose split-list index lands on a literal word of the switch command; punkshell-author-reported; punk-free repro scriptlib/developer/tcl_switch_traceline_repro.tcl, identical 8.6.17/8.7a6/9.0.3). The probe defines a dynamic-body proc, enterstep-traces inner arm 1 (affected index 1 -> reports 3) vs the default arm (index 5, beyond the 4-word command -> reports 2) and matches the characterized wrong/right signature - so detection flips automatically on a fixed Tcl (no version gate; followup steps for that day documented in the proc: re-verify with the repro script, flip the ns/cmdtrace.test GAP pins + canary, update the cmdtrace argdoc caveat, note fixed-in version). Surfaced via 'help tcl' warnings (level medium) alongside the other has_tclbug_* checks; probe is self-cleaning (temp proc/var removed in finally). diff --git a/src/modules/punk/tclparser-999999.0a1.0.tm b/src/modules/punk/tclparser-999999.0a1.0.tm index 0a135c74..71d0ec06 100644 --- a/src/modules/punk/tclparser-999999.0a1.0.tm +++ b/src/modules/punk/tclparser-999999.0a1.0.tm @@ -148,17 +148,6 @@ tcl::namespace::eval punk::tclparser::engine { #gives byte-correct ranges with no separate bookkeeping. variable TCL9 [package vsatisfies [package provide Tcl] 9-] - #\xHH escape consumption differs by runtime: Tcl 8.7+ consumes at most 2 - #hex digits (TIP 388); Tcl 8.6 consumes an unlimited run (value = low - #byte). The engine matches the RUNTIME it executes on, which is also what - #the C library linked to that runtime does (verified against the oracle - #dll under 8.7a6). - variable XHEXMAX - if {[package vsatisfies [package provide Tcl] 8.7-]} { - set XHEXMAX 2 - } else { - set XHEXMAX 999999 - } # -- byte view conversion ------------------------------------------------ proc to_bytes {s} { @@ -278,8 +267,10 @@ tcl::namespace::eval punk::tclparser::engine { proc bs_advance {bytes pos endpos} { #pos is at a backslash: return the position just after the full escape - #sequence, per Tcl_ParseBackslash rules. - variable XHEXMAX + #sequence, per Tcl_ParseBackslash rules. \xHH consumes at most 2 hex + #digits on every supported runtime (TIP 388, in since 8.6 - verified + #against the c library on 8.6.13, 8.7a6 and 9.0.3; unlimited-run \x is + #Tcl 8.5, out of scope). set p [expr {$pos + 1}] if {$p >= $endpos} { return $p @@ -301,7 +292,7 @@ tcl::namespace::eval punk::tclparser::engine { x { incr p set hex 0 - while {$p < $endpos && $hex < $XHEXMAX && [string match {[0-9a-fA-F]} [string index $bytes $p]]} { + while {$p < $endpos && $hex < 2 && [string match {[0-9a-fA-F]} [string index $bytes $p]]} { incr p incr hex } diff --git a/src/tests/modules/punk/lib/testsuites/lib/tclparser_engine.test b/src/tests/modules/punk/lib/testsuites/lib/tclparser_engine.test new file mode 100644 index 00000000..5e5e5c8c --- /dev/null +++ b/src/tests/modules/punk/lib/testsuites/lib/tclparser_engine.test @@ -0,0 +1,174 @@ +package require tcltest +package require punk::tclparser +package require punk::lib + +#added 2026-08-02 (agent, G-070) - pure-Tcl tclparser engine + punk::lib dispatch/fallback. +#Result-shape pins in this file are values verified against the tclparser c +#library oracle (the tclparser_punk fork dlls) during G-070 increments 2-3: +#the engine ran parity-clean against the c library across a 117-case edge +#corpus and ~50k organic command-parses per Tcl generation. This file runs +#everywhere (no c library needed); live comparison against a present c +#library is tclparser_parity.test. + +namespace eval ::testspace { + namespace import ::tcltest::* + variable common { + set result "" + } + + test tclparser_engine_basic {parse command: plain words, 4-tuple shape with byte ranges}\ + -setup $common -body { + punk::tclparser::parse command {cmd arg1 arg2} {} + }\ + -result {{0 0} {0 13} {13 0} {{simple {0 3} {{text {0 3} {}}}} {simple {4 4} {{text {4 4} {}}}} {simple {9 4} {{text {9 4} {}}}}}} + + test tclparser_engine_range0end {parse command: {0 end} range form equals {} range form}\ + -setup $common -body { + set s {cmd arg1 arg2} + expr {[punk::tclparser::parse command $s {0 end}] eq [punk::tclparser::parse command $s {}]} + }\ + -result 1 + + test tclparser_engine_bogus1 {parse command: the punk::lib bogus1-prefix pattern - tree node 0 is simple {0 6}}\ + -setup $common -body { + punk::tclparser::parse command {bogus1 someargument} {} + }\ + -result {{0 0} {0 19} {19 0} {{simple {0 6} {{text {0 6} {}}}} {simple {7 12} {{text {7 12} {}}}}}} + + test tclparser_engine_quoted_word {parse command: dquoted word with variable - word node, text/variable/text subnodes, quotes inside word range}\ + -setup $common -body { + punk::tclparser::parse command {cmd "a $x b"} {} + }\ + -result {{0 0} {0 12} {12 0} {{simple {0 3} {{text {0 3} {}}}} {word {4 8} {{text {5 2} {}} {variable {7 2} {{text {8 1} {}}}} {text {9 2} {}}}}}} + + test tclparser_engine_braced_opaque {parse command: braced word is simple/opaque - text range excludes braces (quote-state arithmetic)}\ + -setup $common -body { + punk::tclparser::parse command {cmd {a [x] b}} {} + }\ + -result {{0 0} {0 13} {13 0} {{simple {0 3} {{text {0 3} {}}}} {simple {4 9} {{text {5 7} {}}}}}} + + test tclparser_engine_expand_literal {parse command: literal {*} expansion expands at parse time - per-element simple nodes with element quoting stripped in text ranges}\ + -setup $common -body { + #this exact sample (with expected output) is documented in punk::lib tclscript_info comments + punk::tclparser::parse command {{*}{"a" {b} c}} {} + }\ + -result {{0 0} {0 14} {14 0} {{simple {4 3} {{text {5 1} {}}}} {simple {8 3} {{text {9 1} {}}}} {simple {12 1} {{text {12 1} {}}}}}} + + test tclparser_engine_expand_complex {parse command: non-literal {*} stays an expand node covering the whole word}\ + -setup $common -body { + punk::tclparser::parse command {{*}[somecmd]} {} + }\ + -result {{0 0} {0 12} {12 0} {{expand {0 12} {{command {3 9} {}}}}}} + + test tclparser_engine_expand_empty {parse command: empty literal expansion produces zero word nodes}\ + -setup $common -body { + punk::tclparser::parse command {cmd {*}{ }} {} + }\ + -result {{0 0} {0 11} {11 0} {{simple {0 3} {{text {0 3} {}}}}}} + + test tclparser_engine_restrange {parse command: newline terminates command (included in commandRange) - restRange walks to the next command}\ + -setup $common -body { + set s "cmd1 a\ncmd2 b" + set p1 [punk::tclparser::parse command $s {}] + lappend result [lindex $p1 1] [lindex $p1 2] + lassign [lindex $p1 2] rstart rlen + set p2 [punk::tclparser::parse command $s [list $rstart $rlen]] + lappend result [lindex $p2 1] [lindex $p2 2] + }\ + -result {{0 7} {7 6} {7 6} {13 0}} + + test tclparser_engine_vararray_nested {parse command: array variable with command substitution in index - variable subnodes name/text/command}\ + -setup $common -body { + punk::tclparser::parse command {cmd $arr(x,[inner y])} {} + }\ + -result {{0 0} {0 21} {21 0} {{simple {0 3} {{text {0 3} {}}}} {word {4 17} {{variable {4 17} {{text {5 3} {}} {text {9 2} {}} {command {11 9} {}}}}}}}} + + test tclparser_engine_multibyte_ranges {parse command: ranges are BYTE offsets - multibyte char occupies its utf-8 byte length}\ + -setup $common -body { + #the e-acute char (U+00E9) is 2 utf-8 bytes, so the word is 5 bytes + punk::tclparser::parse command "cmd caf\u00e9 x" {} + }\ + -result {{0 0} {0 11} {11 0} {{simple {0 3} {{text {0 3} {}}}} {simple {4 5} {{text {4 5} {}}}} {simple {10 1} {{text {10 1} {}}}}}} + + test tclparser_engine_getstring_bytes {parse getstring: extracts by byte range across multibyte content}\ + -setup $common -body { + punk::tclparser::parse getstring "cmd caf\u00e9 x" {4 5} + }\ + -result "caf\u00e9" + + test tclparser_engine_countnewline {parse countnewline: whole string via empty range}\ + -setup $common -body { + punk::tclparser::parse countnewline "a\nb\nc" {} + }\ + -result 2 + + test tclparser_engine_err_messages {parse command: incomplete-parse error messages match the c library}\ + -setup $common -body { + foreach s [list "cmd \x7bunclosed" {cmd "unclosed} {cmd [unclosed}] { + catch {punk::tclparser::parse command $s {}} msg + lappend result $msg + } + set result + }\ + -result [list "missing close-brace" "missing \"" "missing close-bracket"] + + test tclparser_engine_uncovered_subcommand {parse: uncovered subcommands error advising the c library}\ + -setup $common -body { + catch {punk::tclparser::parse expr {1+1} {}} msg + string match "*not implemented in the pure-Tcl engine*package require parser*" $msg + }\ + -result 1 + + test tclparser_engine_no_parser_package {the engine deliberately does not provide the package name 'parser' (capability probe for the c library)}\ + -setup $common -body { + #package provide parser may or may not be non-empty on this runner + #(a kit or installed c library) - but punk::tclparser must never be + #what provides it. Check the ifneeded script for our engine name. + expr {[package provide punk::tclparser] ne "" && [string match "*punk::tclparser*" [package ifneeded parser [package provide punk::tclparser]]] == 0} + }\ + -result 1 + + # -- punk::lib dispatch / fallback ------------------------------------ + + test tclparser_dispatch_forced_tcl {tclword_to_scriptlist works through the forced pure-Tcl engine}\ + -setup $common -body { + punk::lib::tclparser_prefer tcl + set probe {"a string with [puts hello] and [puts world]"} + lappend result [punk::lib::tclparser_prefer] + lappend result [punk::lib::tclscript_info::tclword_to_scriptlist $probe] + }\ + -cleanup { + #restore c preference when the c library is present on this runner + if {![catch {package require parser}]} { + punk::lib::tclparser_prefer c + } + }\ + -result {tcl {{puts hello} {puts world}}} + + test tclparser_dispatch_forced_tcl_nestedvar {tclword_to_scriptlist (pure-Tcl path) recurses into array-index command substitutions}\ + -setup $common -body { + punk::lib::tclparser_prefer tcl + punk::lib::tclscript_info::tclword_to_scriptlist {pre[string map [list \n {}] $seg]post$v(x,[inner y])} + }\ + -cleanup { + if {![catch {package require parser}]} { + punk::lib::tclparser_prefer c + } + }\ + -result {{string map {[list \n {}]} {$seg}} {inner y}} + + test tclparser_tcl_delegation {punk::lib::tclparser_tcl delegates to the engine (former error stub now functional)}\ + -setup $common -body { + punk::lib::tclparser_tcl command {cmd "a b" {c d}} {0 end} + }\ + -result {{0 0} {0 15} {15 0} {{simple {0 3} {{text {0 3} {}}}} {simple {4 5} {{text {5 3} {}}}} {simple {10 5} {{text {11 3} {}}}}}} + + test tclparser_prefer_badarg {tclparser_prefer rejects unknown preferences}\ + -setup $common -body { + catch {punk::lib::tclparser_prefer nonsense} msg + set msg + }\ + -result {punk::lib::tclparser_prefer: unknown preference 'nonsense' - must be c or tcl} + +} +tcltest::cleanupTests ;#needed to produce test summary. diff --git a/src/tests/modules/punk/lib/testsuites/lib/tclparser_parity.test b/src/tests/modules/punk/lib/testsuites/lib/tclparser_parity.test new file mode 100644 index 00000000..435543d7 --- /dev/null +++ b/src/tests/modules/punk/lib/testsuites/lib/tclparser_parity.test @@ -0,0 +1,205 @@ +package require tcltest +package require punk::tclparser +package require punk::lib + +#added 2026-08-02 (agent, G-070) - live parity: punk::tclparser pure-Tcl engine +#vs the tclparser c library, across the recorded probe corpus (edge cases plus +#representative punkshell-style script snippets). Capability-gated: these +#tests run only where the c library is loadable ('package require parser' - +#e.g. a kit shipping the binary, a magicsplat install, or a dir of the +#tclparser_punk fork's built dlls supplied via env PUNK_TCLPARSER_ORACLE_DIR, +#which is appended to auto_path before probing). The engine's behaviour is +#pinned unconditionally (no c library needed) in tclparser_engine.test. + +if {[info exists ::env(PUNK_TCLPARSER_ORACLE_DIR)] && [file isdirectory $::env(PUNK_TCLPARSER_ORACLE_DIR)]} { + lappend ::auto_path $::env(PUNK_TCLPARSER_ORACLE_DIR) +} +tcltest::testConstraint have_c_parser [expr {![catch {package require parser}]}] + +namespace eval ::testspace { + namespace import ::tcltest::* + variable common { + set result "" + } + + #the recorded probe corpus: label + string pairs. Strings cover quoting, + #expansion, variables (incl generation-sensitive forms), command + #substitution, backslashes, comments, terminators, multibyte content and + #error cases - plus representative punkshell-style snippets at the end. + variable corpus [list] + proc case {label string} { + variable corpus + lappend corpus [list $label $string] + } + case bare2 {cmd arg1 arg2} + case bare3 { cmd arg } + case empty {} + case onlynewline "\n" + case onlysemi {;} + case twocmds_nl "cmd1 a\ncmd2 b" + case twocmds_semi {cmd1 a;cmd2 b} + case leading_nl_ws " \n cmd a" + case empty_semis {a;;b} + case bogus1_pattern {bogus1 someargument} + case dquote_var {cmd "a $x b"} + case dquote_cmdsub {cmd "a [inner] b"} + case dquote_nl "cmd \"a\nb\"" + case brace_nested {cmd {a {b c} d}} + case brace_bsbrace "cmd \x7ba\\\x7bb\x7d" + case brace_bsnl "cmd {a\\\n b}" + case midword_brace {cmd a{b}c} + case var_ns {cmd $ns::sub::var} + case var_braced {cmd ${weird name}} + case var_array_cmd {cmd $arr(x,[inner y])} + case var_array_nest {cmd $v(x,$v2(y,[c2]))} + case var_array_empty {cmd $()} + case var_lone_end {cmd a$} + case var_punct {cmd $-} + case varbrace_nest {cmd ${a{b}c}} + case varbrace_esc "cmd \$\x7ba\\\x7db\x7d" + case varbrace_arr {cmd ${a(i)}} + case varbrace_inquote {cmd "pre${a{b}c}post"} + case cmdsub_adjacent {cmd [foo $x bar]z} + case cmdsub_nested {cmd [outer [inner]]} + case cmdsub_multi "cmd \[c1 a\nc2 b\]" + case cmdsub_comment "cmd \[#comment\nreal x\]" + case cmdsub_braced_br {cmd [c1 {a]b}]} + case expand_braced {cmd {*}{a b c}} + case expand_bquoted {cmd {*}{"a" {b} c}} + case expand_quoted {cmd {*}"a b c"} + case expand_empty {cmd {*}{ }} + case expand_ws_list "cmd {*}{\n k1 v1\n k2 v2\n}" + case expand_cmdsub {cmd {*}[getargs]} + case expand_mixed {cmd {*}"a [s] c"} + case expand_var {cmd {*}$var} + case expand_alone {cmd {*}} + case expand_badlist "cmd {*}\"a \x7bb\"" + case expand_bslist {cmd {*}{a\ b c}} + case expand_bracedbs {cmd {*}{{a\ b}}} + case expand_bsnlsep "cmd {*}\\\n next" + case bs_dollar {cmd \$novar} + case bs_hex {cmd \x41BC} + case bs_u4 {cmd \u0041BC} + case bs_octal {cmd \101BC} + case bs_wordsep "cmd a\\\nb" + case bs_quoted_nl "cmd \"a\\\n b\"" + case bs_at_end "cmd a\\" + case comment_cmd "# comment\ncmd a" + case comment_multi "# c1\n# c2\ncmd a" + case comment_cont "# comment \\\ncontinues\ncmd a" + case comment_after_word "cmd a # not comment" + case mb_word "cmd caf\u00e9 after" + case mb_dquote "cmd \"caf\u00e9 \[inner\] x\"" + case mb_var "cmd pre\u00e9\$var" + case mb_high "cmd \u4e2d\u6587 arg" + case mb_astral "cmd a\U0001F600b arg" + case mb_bs_mb "cmd a\\\u00e9b" + case err_brace "cmd \x7bunclosed" + case err_quote {cmd "unclosed} + case err_bracket {cmd [unclosed} + case err_extra_brace {cmd {a}b} + case err_extra_quote {cmd "a"b} + case err_varbrace "cmd \$\x7bunclosed" + case err_varparen {cmd $a(unclosed} + #representative punkshell-style snippets (real source shapes) + case real_dictcreate "dict create {*}{\n key1 value1\n key2 value2\n}" + case real_ifblock {if {$x > 1} {puts "big $x"} else {puts small}} + case real_setcmd {set out [string map [list \n {}] $seg]} + case real_lappend {lappend PUNKARGS [list {stuff here}]} + case real_proc "proc f {a b} {\n return \[expr {\$a + \$b}\]\n}" + case real_argdoc "test x {desc}\\\n -setup \$common -body {\n parse command \$s {}\n }\\\n -result {ok}" + + proc compare_one {s range} { + #returns {} on parity, else a description + set cerr [catch {::parse command $s $range} cres] + set perr [catch {::punk::tclparser::parse command $s $range} pres] + if {$cerr != $perr} { + return "error-status differs (c=$cerr pure=$perr) c:'$cres' pure:'$pres'" + } + if {$cres ne $pres} { + if {$cerr} { + return "error message differs c:'$cres' pure:'$pres'" + } + return "result differs c:'$cres' pure:'$pres'" + } + return {} + } + + test tclparser_parity_corpus {parse command parity across the recorded probe corpus (both range forms)}\ + -constraints have_c_parser\ + -setup $common -body { + variable corpus + foreach entry $corpus { + lassign $entry label s + foreach range {{} {0 end}} { + set diff [compare_one $s $range] + if {$diff ne ""} { + lappend result "$label range=[list $range]: $diff" + } + } + } + set result + }\ + -result {} + + test tclparser_parity_getstring_walk {parse getstring/countnewline parity over every range in every corpus parse tree}\ + -constraints have_c_parser\ + -setup $common -body { + variable corpus + foreach entry $corpus { + lassign $entry label s + if {[catch {::parse command $s {}} cres]} { + continue + } + set ranges [list [lindex $cres 0] [lindex $cres 1] [lindex $cres 2]] + set stack [lindex $cres 3] + while {[llength $stack]} { + set node [lindex $stack 0] + set stack [lrange $stack 1 end] + lappend ranges [lindex $node 1] + foreach sub [lindex $node 2] { + lappend stack $sub + } + } + foreach r $ranges { + set cg [::parse getstring $s $r] + set pg [::punk::tclparser::parse getstring $s $r] + if {$cg ne $pg} { + lappend result "$label getstring $r" + } + } + if {[::parse countnewline $s {}] != [::punk::tclparser::parse countnewline $s {}]} { + lappend result "$label countnewline" + } + } + set result + }\ + -result {} + + test tclparser_parity_entrypoint {tclword_to_scriptlist returns identical results through the c library and the pure-Tcl engine}\ + -constraints have_c_parser\ + -setup $common -body { + set probes [list\ + {"a string with [puts hello] and [puts world]"}\ + {pre[string map [list \n {}] $seg]post$v(x,[inner y])}\ + {{fully opaque [not a command]}}\ + {plainword}\ + ] + foreach probe $probes { + punk::lib::tclparser_prefer c + set rc [punk::lib::tclscript_info::tclword_to_scriptlist $probe] + punk::lib::tclparser_prefer tcl + set rt [punk::lib::tclscript_info::tclword_to_scriptlist $probe] + if {$rc ne $rt} { + lappend result "mismatch for $probe : c='$rc' tcl='$rt'" + } + } + set result + }\ + -cleanup { + punk::lib::tclparser_prefer c + }\ + -result {} + +} +tcltest::cleanupTests ;#needed to produce test summary.