punkshell/scriptlib/developer/linecont_lint.tcl

#!/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
}