Browse Source
The G-173 structured-renderer procs (path_conflicts_for_exe, path_entries, path_render_text, path_render_json, and the punk::path dispatch tail) were authored with \ line-continuation backslashes in proc bodies, violating src/modules/AGENTS.md (debug line-number matching). Refactor every G-173 helper to the dict-create + dict-set accumulator and json::write accumulator idioms so no proc body uses a trailing \. A stray continuation introduced at line 6752 (return [punk::path_machine_return ...]) is replaced with an lappend accumulator + expand. The user's doc-block edits convert the punk::path punk::args::define block from \ continuations to -& record- continuation markers with manually wrapped help text (table-width safe). Add scriptlib/developer/linecont_lint.tcl, a linter that flags \<newline> continuations outside punk::args doc blocks. It resolves a real Tcl parser (the C tclparser library, or punk::lib's pure-Tcl punk::tclparser fallback) and locates doc-block spans structurally (punk::args::define brace arg, lappend PUNKARGS command range) so the exemption is not a regex guess; comment-line trailing \ is also exempt. Sourceable linecont_lint_run proc with a script-mode guard; run as a script it exits 0 clean / 1 findings / 2 usage. 5 pinning tests in runner/testsuites/parser/linecontlint.test cover proc-body flagging, punk::args::define exemption, lappend PUNKARGS exemption, comment-line exemption, and a clean expand-style proc (pass Tcl 9 + 8.6). src/modules/AGENTS.md: the -& record-continuation marker is now REQUIRED for new and edited punk::args doc blocks (existing blocks may keep \ until touched; editing a \ block requires converting to -& in the same change); the closeout trailing-\ search is cross-referenced to the linter. Assisted-by: harness=pi; primary-model=huggingface/zai-org/GLM-5.2; api-location=huggingface.comaster
4 changed files with 443 additions and 124 deletions
@ -0,0 +1,255 @@
|
||||
#!/usr/bin/env tclsh |
||||
# linecont_lint.tcl - lint Tcl line-continuation backslashes outside doc blocks |
||||
# |
||||
# Per src/modules/AGENTS.md, line-continuation backslashes (\ at end of a line) |
||||
# must NOT appear in proc bodies or other executable code - they make debug |
||||
# line-number matching harder and the expand {dict create {*}...} / accumulator |
||||
# idioms are the required style. The ONLY allowed context is punk::args doc |
||||
# blocks (punk::args::define {...}, lappend PUNKARGS {...} / [list {...}]), |
||||
# where \ (legacy) or -& (preferred) record continuation is part of the |
||||
# definition dialect. |
||||
# |
||||
# This linter reports \ line-continuations in non-docblock contexts. It uses a |
||||
# real Tcl parser (the tclparser C library via 'package require parser', or the |
||||
# pure-Tcl punk::tclparser fallback wired by punk::lib::tclparser_prefer) to |
||||
# locate doc-block spans STRUCTURALLY (so the exemption is not a regex guess): |
||||
# the brace argument to punk::args::define, and the command range of |
||||
# 'lappend PUNKARGS ...'. Everything else - proc bodies, command lines, |
||||
# continuations inside [...] substitution, comments - is scanned for \newline |
||||
# and flagged. A \ inside a braced doc block is exempt; a \ inside a braced |
||||
# proc body is NOT (it is a real continuation when the body runs). |
||||
# |
||||
# Run under a punk environment so punk::lib can resolve the parser (the C lib |
||||
# ships in the punk9win kit; the pure-Tcl fallback is in src/modules/punk/tclparser): |
||||
# punk91 src script lib:developer/linecont_lint <path|glob|dir>... |
||||
# tclsh scriptlib/developer/linecont_lint.tcl <path|glob|dir>... (if parser present) |
||||
# Exit 0 when clean; exit 1 with one 'path:line: <msg>' line per finding; exit 2 |
||||
# on usage error or if no parser is available. |
||||
# |
||||
# Limitations (v1): |
||||
# - The 'lappend PUNKARGS ...' exemption is by whole command range (covers both |
||||
# 'lappend PUNKARGS {doc}' and 'lappend PUNKARGS [list {doc}]'); a \ on the |
||||
# same physical line as 'lappend PUNKARGS' but outside the doc would be |
||||
# missed - acceptable (doc authoring only). |
||||
# - A \ inside a braced DATA literal that is not a doc block (e.g. a multi-line |
||||
# braced string constant passed to a non-doc command) is flagged as a |
||||
# false positive - rare in practice; the expand idiom avoids it. |
||||
# - The parser's 'parse command' wrapper does not expose [...] sub-commands, so |
||||
# the linter cannot exempt a doc block nested inside [...] - but doc blocks |
||||
# are not authored that way, so this is a non-issue. |
||||
|
||||
# --- parser bootstrap ------------------------------------------------------ |
||||
set parse_cmd "" |
||||
if {![catch {package require parser}]} { |
||||
set parse_cmd ::parse |
||||
} elseif {![catch {package require punk::lib}]} { |
||||
catch {punk::lib::tclparser_prefer c} |
||||
if {[llength [info commands ::punk::lib::parse]]} { |
||||
set parse_cmd ::punk::lib::parse |
||||
} else { |
||||
catch {punk::lib::tclparser_prefer tcl} |
||||
if {[llength [info commands ::punk::lib::parse]]} { |
||||
set parse_cmd ::punk::lib::parse |
||||
} |
||||
} |
||||
} |
||||
if {$parse_cmd eq ""} { |
||||
puts stderr "linecont_lint: no Tcl parser available - need 'package require parser' (C tclparser) or punk::lib (pure-Tcl fallback). Run via 'punk91 src script lib:developer/linecont_lint ...'." |
||||
exit 2 |
||||
} |
||||
|
||||
set script_body_cmds {proc apply lambda if elseif else while for foreach try catch eval uplevel namespace time} |
||||
|
||||
proc is_doc_cmd {words} { |
||||
set cmd [lindex $words 0] |
||||
if {$cmd eq "punk::args::define" || $cmd eq "::punk::args::define"} { return 1 } |
||||
if {$cmd eq "lappend" || $cmd eq "::lappend"} { |
||||
if {[lindex $words 1] eq "PUNKARGS"} { return 2 } |
||||
} |
||||
return 0 |
||||
} |
||||
proc is_script_body_cmd {cmd} { |
||||
variable script_body_cmds |
||||
expr {$cmd in $script_body_cmds || $cmd in [lmap c $script_body_cmds {list ::$c}]} |
||||
} |
||||
|
||||
#collect exempt spans (doc blocks) into ::exempt, as [start end) offsets in the |
||||
#FILE text ($text). $script is the substring being parsed, $base its offset. |
||||
proc collect_doc_spans {text script base} { |
||||
#Parse a SUFFIX substring at each step (always {0 end}) and adjust offsets |
||||
#by +$pos. The parser's range-start argument is honoured in isolation but |
||||
#misbehaves mid-string around backslash-continuations; feeding a suffix |
||||
#avoids that fragility entirely. Token offsets returned by the parser are |
||||
#relative to $suffix; word extraction uses $suffix, brace detection and |
||||
#body extraction shift by +$pos into the $script frame. |
||||
set pos 0 |
||||
set slen [string length $script] |
||||
set iter 0 |
||||
while {$pos < $slen} { |
||||
incr iter |
||||
if {$iter > 500000} { puts stderr "linecont_lint: bailed (iteration cap) collecting doc spans at base $base"; return } |
||||
set suffix [string range $script $pos end] |
||||
set rc [catch {$::parse_cmd command $suffix {0 end}} res] |
||||
if {$rc} { return } |
||||
lassign $res commentRange commandRange remainderRange tokens |
||||
set cstart [expr {[lindex $commandRange 0] + $pos}] |
||||
set clen [lindex $commandRange 1] |
||||
#comment span (covers \ in a comment line - harmless comment continuation, |
||||
#not a command continuation): record as exempt. Present for both |
||||
#comment-only (clen 0) and command-with-leading-comment (clen>0) parses. |
||||
set cmt_start [expr {[lindex $commentRange 0] + $pos}] |
||||
set cmt_len [lindex $commentRange 1] |
||||
if {$cmt_len > 0} { |
||||
lappend ::exempt [list [expr {$base + $cmt_start}] [expr {$base + $cmt_start + $cmt_len}]] |
||||
} |
||||
if {$clen == 0} { |
||||
set adv [expr {[lindex $commentRange 0] + [lindex $commentRange 1] + $pos}] |
||||
if {$adv <= $pos} { incr adv } |
||||
set pos $adv |
||||
continue |
||||
} |
||||
set cend [expr {$cstart + $clen}] |
||||
if {$cend <= $pos} { set pos [expr {max($cend, $pos) + 1}]; continue } |
||||
#word strings (tokens are suffix-relative -> use $suffix) |
||||
set words [list] |
||||
foreach tok $tokens { |
||||
lappend words [token_word $suffix $tok] |
||||
} |
||||
set doc [is_doc_cmd $words] |
||||
if {$doc == 1} { |
||||
set tokidx 0 |
||||
foreach tok $tokens { |
||||
if {$tokidx == 0} { incr tokidx; continue } |
||||
lassign [token_outer $tok] sost solen |
||||
set ostart [expr {$sost + $pos}] |
||||
set olen $solen |
||||
if {$olen >= 2 && [string index $script $ostart] eq "\{"} { |
||||
lappend ::exempt [list [expr {$base + $ostart}] [expr {$base + $ostart + $olen}]] |
||||
} |
||||
incr tokidx |
||||
} |
||||
} elseif {$doc == 2} { |
||||
lappend ::exempt [list [expr {$base + $cstart}] [expr {$base + $cend}]] |
||||
} |
||||
#recurse into script-body braces to find nested doc blocks (e.g. a |
||||
#punk::args::define inside a namespace eval argdoc inside a proc). |
||||
set cmd [lindex $words 0] |
||||
if {($cmd eq "dict" || $cmd eq "::dict") && [lindex $words 1] in {update with}} { |
||||
set last [lindex $tokens end] |
||||
lassign [token_outer $last] sost solen |
||||
set ostart [expr {$sost + $pos}] |
||||
set olen $solen |
||||
if {$olen >= 2 && [string index $script $ostart] eq "\{"} { |
||||
set body [string range $script [expr {$ostart+1}] [expr {$ostart+$olen-2}]] |
||||
collect_doc_spans $text $body [expr {$base + $ostart + 1}] |
||||
} |
||||
} elseif {[is_script_body_cmd $cmd]} { |
||||
foreach tok [lrange $tokens 1 end] { |
||||
lassign [token_outer $tok] sost solen |
||||
set ostart [expr {$sost + $pos}] |
||||
set olen $solen |
||||
if {$olen >= 2 && [string index $script $ostart] eq "\{"} { |
||||
set body [string range $script [expr {$ostart+1}] [expr {$ostart+$olen-2}]] |
||||
collect_doc_spans $text $body [expr {$base + $ostart + 1}] |
||||
} |
||||
} |
||||
} |
||||
set pos $cend |
||||
} |
||||
} |
||||
|
||||
#token helpers. tok: {simple {outerStart outerLen} {{text {innerStart innerLen} {value}} ...}} |
||||
proc token_outer {tok} { |
||||
set r [lindex $tok 1] |
||||
return [list [lindex $r 0] [lindex $r 1]] |
||||
} |
||||
proc token_word {script tok} { |
||||
if {[llength $tok] < 3} { return "" } |
||||
set firstsub [lindex [lindex $tok 2] 0] |
||||
set irange [lindex $firstsub 1] |
||||
set istart [lindex $irange 0] |
||||
set ilen [lindex $irange 1] |
||||
return [string range $script $istart [expr {$istart+$ilen-1}]] |
||||
} |
||||
|
||||
proc offset_to_line {text off} { |
||||
set n 1 |
||||
for {set i 0} {$i < $off && $i < [string length $text]} {incr i} { |
||||
if {[string index $text $i] eq "\n"} { incr n } |
||||
} |
||||
return $n |
||||
} |
||||
proc in_exempt {off} { |
||||
foreach sp $::exempt { |
||||
if {$off >= [lindex $sp 0] && $off < [lindex $sp 1]} { return 1 } |
||||
} |
||||
return 0 |
||||
} |
||||
|
||||
set findings [list] |
||||
proc flag {path line msg} { lappend ::findings "$path:$line: $msg" } |
||||
|
||||
# --- file collection ------------------------------------------------------- |
||||
proc collect_files {args} { |
||||
set files [list] |
||||
foreach a $args { |
||||
if {[string match {*[\[\?\*]*} $a]} { |
||||
foreach f [glob -nocomplain -type f $a] { lappend files $f } |
||||
} elseif {[file isfile $a]} { |
||||
lappend files $a |
||||
} elseif {[file isdir $a]} { |
||||
foreach f [glob -nocomplain -type f -directory $a -- *.tcl *.tm] { lappend files $f } |
||||
} |
||||
} |
||||
return $files |
||||
} |
||||
|
||||
# --- main: sourceable proc + script-mode guard ---------------------------- |
||||
# linecont_lint_run <files...> -> list of finding strings (empty if clean). |
||||
# Sourceable: when this file is sourced (not run as a script), the proc is |
||||
# defined and nothing runs; callers invoke it and read the result. When run as a |
||||
# script, the trailing guard invokes it and exits with 0/1/2. |
||||
proc linecont_lint_run {files} { |
||||
set ::exempt [list] |
||||
set ::findings [list] |
||||
foreach f $files { |
||||
set fd [open $f r] |
||||
set text [read $fd] |
||||
close $fd |
||||
set ::exempt [list] |
||||
collect_doc_spans $text $text 0 |
||||
set tlen [string length $text] |
||||
for {set i 0} {$i < $tlen} {incr i} { |
||||
if {[string index $text $i] ne "\\"} continue |
||||
set nx [string index $text [expr {$i+1}]] |
||||
if {$nx ne "\n" && $nx ne "\r"} continue |
||||
if {![in_exempt $i]} { |
||||
flag $f [offset_to_line $text $i] "line-continuation backslash outside a punk::args doc block (use expand {dict create {*}...} / accumulators, or -& in a doc block, per src/modules/AGENTS.md)" |
||||
} |
||||
incr i |
||||
} |
||||
} |
||||
return $::findings |
||||
} |
||||
|
||||
#script-mode only: when this file is the invoked script, parse argv and exit. |
||||
if {[info exists ::argv0] && [file normalize $::argv0] eq [file normalize [info script]]} { |
||||
if {$argc == 0} { |
||||
puts stderr "usage: $argv0 <path|glob|dir>... |
||||
lints Tcl .tcl/.tm files for line-continuation backslashes outside punk::args doc blocks" |
||||
exit 2 |
||||
} |
||||
set files [collect_files {*}$argv] |
||||
if {![llength $files]} { |
||||
puts stderr "linecont_lint: no .tcl/.tm files matched: $argv" |
||||
exit 2 |
||||
} |
||||
set findings [linecont_lint_run $files] |
||||
if {[llength $findings]} { |
||||
foreach fl $findings { puts $fl } |
||||
puts stderr "linecont_lint: [llength $findings] finding(s) across [llength $files] file(s)" |
||||
exit 1 |
||||
} |
||||
puts stderr "linecont_lint: clean ([llength $files] file(s) checked)" |
||||
exit 0 |
||||
} |
||||
@ -0,0 +1,113 @@
|
||||
# -*- tcl -*- |
||||
# Unit suite for scriptlib/developer/linecont_lint.tcl - the line-continuation |
||||
# linter that flags \ line-continuations outside punk::args doc blocks. Pins |
||||
# the behaviours that matter: a \ in a proc body is flagged; a \ inside a |
||||
# punk::args doc block (punk::args::define / lappend PUNKARGS) is exempt; a \ at |
||||
# the end of a comment line is exempt (harmless comment continuation). |
||||
# |
||||
# Fixture bodies are built with string map from placeholder templates because |
||||
# Tcl braces JOIN backslash-newline into a space (the lexer processes \<nl> |
||||
# even inside braces), so a braced literal cannot carry a real line-continuation |
||||
# backslash. Placeholders ~BS~ ~NL~ ~OB~ ~CB~ ~OBK~ ~CBK~ stand in for |
||||
# \ newline { } [ ] so the template stays balanced and the mapped body carries |
||||
# genuine \<nl> continuations. The ~ delim is chosen so adjacent placeholders |
||||
# (~OB~~CB~) and prefix-overlap pairs (~OB~ vs ~OBK~) do not collide under |
||||
# string map's left-to-right longest-first scan. |
||||
# |
||||
# The linter is SOURCED into the test interp (so punk::lib's pure-Tcl tclparser |
||||
# fallback resolves via the test module path, no child-exec parser bootstrap); |
||||
# the suite is capability-gated on the linter resolving a parser. |
||||
# |
||||
# Run: tclsh src/tests/runtests.tcl -report compact -show-passes 0 -include-paths runner/testsuites/parser linecontlint.test |
||||
|
||||
package require tcltest |
||||
|
||||
set _lcl_root [file dirname [file dirname [file dirname [file dirname [file dirname [file dirname [file normalize [info script]]]]]]]] |
||||
set _lcl_script [file join $_lcl_root scriptlib developer linecont_lint.tcl] |
||||
|
||||
#source the linter (defines linecont_lint_run + resolves ::parse_cmd via |
||||
#package require parser or punk::lib's pure-Tcl fallback). |
||||
source $_lcl_script |
||||
#the linter sets ::parse_cmd to the resolved 'parse command' implementation, or |
||||
#"" if none resolved. Capability-gate on that. |
||||
tcltest::testConstraint linecontLintCapable [expr {$::parse_cmd ne ""}] |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
proc mkbody {tpl} { |
||||
string map [list ~BS~ "\\" ~NL~ "\n" ~OB~ "{" ~CB~ "}" ~OBK~ "\[" ~CBK~ "\]"] $tpl |
||||
} |
||||
|
||||
proc write_fixture {body} { |
||||
set fixture [file join [tcltest::temporaryDirectory] lcl_fixture_[clock clicks].tcl] |
||||
set fd [open $fixture w] |
||||
fconfigure $fd -translation lf |
||||
puts -nonewline $fd $body |
||||
close $fd |
||||
return $fixture |
||||
} |
||||
|
||||
#added 2026-08-07 (agent - linecont_lint: line-continuation linter for non-docblock contexts) |
||||
test linecontlint-1.0 {backslash continuation in a proc body is flagged} -constraints linecontLintCapable -body { |
||||
set f [write_fixture [mkbody {proc bad ~OB~~CB~ ~OB~ |
||||
set entry ~OBK~dict create ~BS~~NL~ idx 1 ~BS~~NL~ path /x~CBK~ |
||||
~CB~ |
||||
}]] |
||||
set out [linecont_lint_run [list $f]] |
||||
set facts [list] |
||||
lappend facts [regexp {line-continuation backslash outside a punk::args doc block} $out] |
||||
lappend facts [llength [lsearch -all -inline -regexp $out {:[0-9]+: line-continuation}]] |
||||
set facts |
||||
} -result {1 2} |
||||
|
||||
#added 2026-08-07 (agent - linecont_lint) |
||||
test linecontlint-1.1 {backslash inside a punk::args::define doc block is exempt} -constraints linecontLintCapable -body { |
||||
set f [write_fixture [mkbody {namespace eval argdoc ~OB~ |
||||
punk::args::define ~OB~ |
||||
@id -id ::foo |
||||
@cmd -name "foo" ~BS~~NL~ -summary "a thing" |
||||
~CB~ |
||||
~CB~ |
||||
}]] |
||||
expr {[llength [linecont_lint_run [list $f]]] == 0} |
||||
} -result 1 |
||||
|
||||
#added 2026-08-07 (agent - linecont_lint) |
||||
test linecontlint-1.2 {backslash inside an lappend PUNKARGS doc block is exempt} -constraints linecontLintCapable -body { |
||||
set f [write_fixture [mkbody {namespace eval argdoc ~OB~ |
||||
lappend PUNKARGS ~OBK~list ~OB~ |
||||
@id -id ::foo |
||||
@cmd -name "foo" ~BS~~NL~ -summary "a thing" |
||||
~CB~~CBK~ |
||||
~CB~ |
||||
}]] |
||||
expr {[llength [linecont_lint_run [list $f]]] == 0} |
||||
} -result 1 |
||||
|
||||
#added 2026-08-07 (agent - linecont_lint) |
||||
test linecontlint-1.3 {backslash at the end of a comment line is exempt} -constraints linecontLintCapable -body { |
||||
set f [write_fixture [mkbody {proc ok ~OB~~CB~ ~OB~ |
||||
#will do nothing if already prefixed with ~BS~~BS~?~BS~~NL~ set x 1 |
||||
~CB~ |
||||
}]] |
||||
expr {[llength [linecont_lint_run [list $f]]] == 0} |
||||
} -result 1 |
||||
|
||||
#added 2026-08-07 (agent - linecont_lint) |
||||
test linecontlint-1.4 {clean proc with expand-style dict create reports no findings} -constraints linecontLintCapable -body { |
||||
set f [write_fixture [mkbody {proc good ~OB~~CB~ ~OB~ |
||||
set entry ~OBK~dict create idx 1~CBK~ |
||||
dict set entry path /x |
||||
set s ~OBK~json::write object a ~OBK~json::write string x~CBK~ b ~OBK~json::write string y~CBK~~CBK~ |
||||
~CB~ |
||||
}]] |
||||
expr {[llength [linecont_lint_run [list $f]]] == 0} |
||||
} -result 1 |
||||
|
||||
cleanupTests |
||||
} |
||||
|
||||
# Local Variables: |
||||
# mode: tcl |
||||
# End: |
||||
Loading…
Reference in new issue