jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

bootsupport: promote tcltestrun 0.4.0 (G-161) + sweep pending console 0.8.1 / shellfilter 0.2.5 

make.tcl modules + make.tcl bootsupport outputs batch (punkcheck-managed):
- punk/tcltestrun 0.3.1 -> 0.4.0 (the G-161 multi-line banner parser -
  runtests.tcl's parent loads the bootsupport copy, so this promotion is
  what puts the tolerant parser in front of the runner)
- punk/console 0.8.0 -> 0.8.1 and shellfilter 0.2.4 -> 0.2.5: already
  committed in src/modules and already promoted into _vfscommon
  (ac032b96/8864e5ce); this bootsupport run swept the snapshots current
- punk/mix/templates-0.2.0.tm re-packed by the mint (modpod payload
  refresh, no source change)

Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
Julian Noble 7 days ago
parent
08804abfc4
commit
11dbe02d02
4 changed files with 258 additions and 39 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 123
      src/bootsupport/modules/punk/console-0.8.1.tm
  2. BIN
      src/bootsupport/modules/punk/mix/templates-0.2.0.tm
  3. 102
      src/bootsupport/modules/punk/tcltestrun-0.4.0.tm
  4. 72
      src/bootsupport/modules/shellfilter-0.2.5.tm

123
src/bootsupport/modules/punk/console-0.8.0.tm → src/bootsupport/modules/punk/console-0.8.1.tm
Unescape View File

@ -7,7 +7,7 @@
# (C) 2023
#
# @@ Meta Begin
# Application punk::console 0.8.0
# Application punk::console 0.8.1
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
@ -17,7 +17,7 @@
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin punkshell_module_punk::console 0 0.8.0]
#[manpage_begin punkshell_module_punk::console 0 0.8.1]
#[copyright "2024"]
#[titledesc {punk console}] [comment {-- Name section and table of contents description --}]
#[moddesc {punk console}] [comment {-- Description at end of page heading --}]
@ -2809,6 +2809,30 @@ namespace eval punk::console {
return [dict create columns 80 rows 24]
}
lappend PUNKARGS [list {
@id -id ::punk::console::size_result_valid
@cmd -name punk::console::size_result_valid -summary\
"True if a size-mechanism result is a well-formed {columns <int> rows <int>} dict."
@values -min 1 -max 1
sizedict -type any -help\
"Candidate result from a get_size_using_* mechanism."
}]
proc size_result_valid {sizedict} {
#see PUNKARGS id ::punk::console::size_result_valid
#Guard for size_via_query_mechanisms: a mechanism 'success' must be well-formed.
#Mechanisms can otherwise return malformed data without erroring and win the
#cached-mechanism loop silently (the 2026-08-03 tput single-capname regression
#class - and the ANSI mechanisms return {columns {} rows {}} on a query timeout).
if {[catch {dict size $sizedict} pairs] || $pairs != 2} {
return 0
}
expr {
[dict exists $sizedict columns] && [dict exists $sizedict rows]
&& [string is integer -strict [dict get $sizedict columns]]
&& [string is integer -strict [dict get $sizedict rows]]
}
}
#ANSI/tput size mechanisms with per-console-pair timing cache. Returns a dict
#{columns <int> rows <int>} or an empty dict when size cannot be determined.
#Used by the legacy get_size channel path and (as console_size_provider) by the base
@ -2828,7 +2852,10 @@ namespace eval punk::console {
#see PUNKARGS id ::punk::console::size_via_query_mechanisms
if {[console_fact_get $inoutchannels is_vt52]} {
#vt52 doesn't support cursor save/restore or cursor position reports.
if {![catch {get_size_using_tput $inoutchannels} sizedict]} {
if {![catch {get_size_using_sttysize $inoutchannels} sizedict] && [size_result_valid $sizedict]} {
return $sizedict
}
if {![catch {get_size_using_tput $inoutchannels} sizedict] && [size_result_valid $sizedict]} {
return $sizedict
}
return [dict create]
@ -2841,19 +2868,25 @@ namespace eval punk::console {
#we will also use the results for our initial return of the size.
set successful_mechs [list]
set sizedict [dict create]
if {![catch {get_size_using_cursorrestore $inoutchannels} result]} {
if {![catch {get_size_using_cursorrestore $inoutchannels} result] && [size_result_valid $result]} {
lappend successful_mechs "cursorrestore"
if {![dict size $sizedict]} {
set sizedict $result
}
}
if {![catch {get_size_using_cursormove $inoutchannels} result]} {
if {![catch {get_size_using_cursormove $inoutchannels} result] && [size_result_valid $result]} {
lappend successful_mechs "cursormove"
if {![dict size $sizedict]} {
set sizedict $result
}
}
if {![catch {get_size_using_tput $inoutchannels} result] } {
if {![catch {get_size_using_sttysize $inoutchannels} result] && [size_result_valid $result]} {
lappend successful_mechs "sttysize"
if {![dict size $sizedict]} {
set sizedict $result
}
}
if {![catch {get_size_using_tput $inoutchannels} result] && [size_result_valid $result]} {
lappend successful_mechs "tput"
if {![dict size $sizedict]} {
set sizedict $result
@ -2879,7 +2912,7 @@ namespace eval punk::console {
}
foreach mech [dict get $get_size_mechanism $inoutchannels] {
if {![catch {get_size_using_$mech $inoutchannels} sizedict]} {
if {![catch {get_size_using_$mech $inoutchannels} sizedict] && [size_result_valid $sizedict]} {
return $sizedict
}
}
@ -2971,6 +3004,11 @@ namespace eval punk::console {
#this mechanism is much faster than ansi cursor movements
#REVIEW check if any x-platform anomalies with this method?
#can -winsize key exist but contain erroneous info? We will check that we get 2 ints at least
#NOTE (verified 2026-08-03, tcl 9.0.2): unix tty/serial channels do NOT expose -winsize
#(windows console channels do) - so on unix this mechanism currently always falls through.
#If a future tcl adds unix -winsize, be aware a stacked/reflected stdout (e.g the repl's
#shellfilter stack) masks the underlying tty's options - probing the base tty channel
#(or /dev/tty) would be needed for it to be seen under stacked channels.
lassign [dict get $outconf -winsize] cols lines
if {[string is integer -strict $cols] && [string is integer -strict $lines]} {
return [dict create columns $cols rows $lines]
@ -2979,6 +3017,34 @@ namespace eval punk::console {
error "chan configure method of getting console size not supported or failed to get valid size info"
}
lappend PUNKARGS [list {
@id -id ::punk::console::get_size_using_sttysize
@cmd -name punk::console::get_size_using_sttysize -summary\
"Console size via 'stty size' on the input channel's tty (single fork) - errors when unavailable or input is not a tty."
@values -min 0 -max 1
inoutchannels -type list -default {stdin stdout} -optional 1 -help\
"Canonical {in out} channel pair (internal size mechanism - not spec-form aware)."
}]
proc get_size_using_sttysize {{inoutchannels {stdin stdout}}} {
#see PUNKARGS id ::punk::console::get_size_using_sttysize
#'stty size' emits "<rows> <cols>" from the tty on its stdin - a single fork with a
#fixed output shape (GNU, busybox and BSD stty all support it - not strictly POSIX).
#Preferred over tput for the exec-based fallback tier: tput multi-capname handling
#varies by implementation (see get_size_using_tput autodetect). Non-tty input makes
#stty error, which correctly drops this mechanism from size_via_query_mechanisms.
set in [lindex $inoutchannels 0]
set sttycmd [auto_execok stty]
if {$sttycmd eq ""} {
error "stty command not found - cannot use stty size method to get console size"
}
set sizeinfo [string trim [exec {*}$sttycmd size <@$in]]
lassign $sizeinfo lines cols
if {![string is integer -strict $lines] || ![string is integer -strict $cols] || $lines < 1 || $cols < 1} {
error "stty size returned '$sizeinfo' - not usable as '<rows> <cols>'"
}
return [dict create columns $cols rows $lines]
}
lappend PUNKARGS [list {
@id -id ::punk::console::get_size_using_tput
@cmd -name punk::console::get_size_using_tput -summary\
@ -2993,7 +3059,44 @@ namespace eval punk::console {
if {$tputcmd eq ""} {
error "tput command not found - cannot use tput method to get console size"
}
lassign [exec {*}$tputcmd lines cols] lines cols
#tput multi-capname behaviour varies by implementation: ncurses >= 6.1 and the BSD
#tputs emit one value per capname ("66\n266"), but older ncurses treats the second
#capname as an (ignored) parameter of the first and emits only "66" - which used to
#lassign cols to "" here and return 'columns {} rows 66' (2026-08-03 WSL get_size
#regression once the mechanism-timing cache ranked tput first). Autodetect by result
#shape on first use and remember per tput path - capable tputs stay single-fork,
#single-cap-only tputs settle into two forks per call.
variable tput_multicap
if {![info exists tput_multicap]} {set tput_multicap [dict create]}
if {[dict exists $tput_multicap $tputcmd] && ![dict get $tput_multicap $tputcmd]} {
set lines [string trim [exec {*}$tputcmd lines]]
set cols [string trim [exec {*}$tputcmd cols]]
} else {
set outdata [exec {*}$tputcmd lines cols]
set values [list]
foreach v [split $outdata \n] {
set v [string trim $v]
if {$v ne ""} {lappend values $v}
}
switch -- [llength $values] {
2 {
lassign $values lines cols
dict set tput_multicap $tputcmd 1
}
1 {
#single-cap-only tput evaluated 'lines' and ignored 'cols'
dict set tput_multicap $tputcmd 0
set lines [lindex $values 0]
set cols [string trim [exec {*}$tputcmd cols]]
}
default {
error "tput lines cols returned '$outdata' - unrecognised output shape"
}
}
}
if {![string is integer -strict $lines] || ![string is integer -strict $cols] || $lines < 1 || $cols < 1} {
error "tput returned lines='$lines' cols='$cols' - not usable as positive integers"
}
return [dict create columns $cols rows $lines]
}
@ -5787,7 +5890,7 @@ namespace eval punk::console::system {
# Standalone debug run example (from this directory):
# pwsh -nop -nol -f consolemode_server_async.ps1 test1 0 1
# Protocol (one line per named-pipe connection): enableraw | disableraw | ping | exit
# MAINTENANCE: src/modules/punk/console-0.8.0.tm carries this file's text as
# MAINTENANCE: src/modules/punk/console-0.8.1.tm carries this file's text as
# punk::console::system::ps_consolemode_script_embedded (the last-resort resolution for kits and
# unusual cwds). Keep the two in sync - the console testsuite (psfallback.test) fails when they diverge.
;
@ -6906,7 +7009,7 @@ namespace eval ::punk::args::register {
## Ready
package provide punk::console [namespace eval punk::console {
variable version
set version 0.8.0
set version 0.8.1
}]
return

BIN
src/bootsupport/modules/punk/mix/templates-0.2.0.tm
View File

Binary file not shown.

102
src/bootsupport/modules/punk/tcltestrun-0.3.1.tm → src/bootsupport/modules/punk/tcltestrun-0.4.0.tm
Unescape View File

@ -8,7 +8,7 @@
# (C) 2026
#
# @@ Meta Begin
# Application punk::tcltestrun 0.3.1
# Application punk::tcltestrun 0.4.0
# Meta platform tcl
# Meta license BSD
# @@ Meta End
@ -36,7 +36,12 @@ tcl::namespace::eval punk::tcltestrun {
"Parse a dict containing stderr and stdout keys into testresult summary data."\
-help\
"Parse a dict containing stderr and stdout keys into testresult summary data.
The dict is expected to be in the format returned by shellrun::runx from execution of a tcltest script"
The dict is expected to be in the format returned by shellrun::runx from execution of a tcltest script.
Intended for streams produced with tcltest -verbose {body pass skip start error line usec} (the
runtests.tcl configuration). Failing tests whose descriptions contain embedded newlines (multi-line
opening banners) are parsed with full fidelity when the stream carries -verbose start events; without
start events such banners are not recognised and parsing degrades to the historic single-line-only
behaviour."
@leaders
@opts
@values -min 1 -max 2
@ -81,12 +86,63 @@ tcl::namespace::eval punk::tcltestrun {
set test_case_pass [dict create]
#dict set test_case_pass microseconds 0
set test_case_time [dict create]
#most recently started test name, from "---- <name> start" lines (-verbose start).
#Anchor for multi-line opening-banner recognition (G-161): without start events the
#parser retains its historic single-line-banner-only behaviour.
set current_start_name ""
switch -- $what {
stdout {
foreach ln [split $chunk \n] {
set ln_trimright [string trimright $ln]
incr i
set fail_stage [dict get $test_case_fail stage]
if {$fail_stage eq "banner"} {
#G-161: accumulating the remainder of a multi-line opening banner.
#tcltest emits the opening banner as ONE puts of
# ==== <name> <description> FAILED
#and trims only the description's ENDS, so a description containing
#embedded newlines makes the banner span physical lines: the first line
#starts "==== <name> " (recognised by the anchored entry point below) and
#the final line always ends " FAILED" (the description's last line is
#non-whitespace-terminated, so the space before FAILED is guaranteed).
if {[string match "* FAILED" $ln_trimright]} {
#banner complete - same state as a single-line opener
dict append test_case_fail test_openingtext "\n[string range $ln_trimright 0 end-7]"
dict set test_case_fail stage open
dict unset test_case_fail banner_lines
dict append results out "<stdout><$pkg> $ln" \n
continue
} elseif {[string match "==== Contents of test case:*" $ln]} {
#terminator line missed (pathological description content) - treat the
#banner as complete and take the open->contents transition so the
#parser cannot wedge waiting for a line that already went past
dict set test_case_fail stage contents
dict unset test_case_fail banner_lines
dict append results out "<stdout><$pkg> $ln" \n
continue
} elseif {[string match "++++ * took *" $ln_trimright]
|| [string match "++++ * PASSED" $ln_trimright]
|| [string match "++++ * SKIPPED: *" $ln_trimright]
|| [string match "---- * start" $ln_trimright]
|| [string match "*:*Total*Passed*Skipped*Failed*" $ln]
|| [dict get $test_case_fail banner_lines] >= 100} {
#a recognisable event line (or an implausibly long banner) while
#accumulating: this was not a banner after all - abandon capture and
#reprocess the current line through normal handling below.
#Already-buffered lines were ordinary output; they remain in 'out'
#where they were appended as they streamed.
dict set test_case_fail stage ""
dict set test_case_fail test_openingtext ""
dict unset test_case_fail banner_lines
set fail_stage ""
#deliberate fall-through - no continue
} else {
dict append test_case_fail test_openingtext "\n$ln"
dict incr test_case_fail banner_lines
dict append results out "<stdout><$pkg> $ln" \n
continue
}
}
if {$fail_stage eq ""} {
#not within a test case failure section, so we can parse summary lines and other output normally.
@ -124,6 +180,17 @@ tcl::namespace::eval punk::tcltestrun {
continue
}
# ---- <testname_words> start (-verbose start; the runner always enables it)
# Track the most recently started test: the anchor that lets a multi-line
# opening banner be recognised by name prefix (G-161). The name may itself
# contain spaces and even the word "start", so anchor on the LAST " start".
if {[string match "---- * start" $ln_trimright]} {
set start_pos [string last " start" $ln_trimright]
set current_start_name [string range $ln_trimright 5 [expr {$start_pos - 1}]]
dict append results out "<stdout><$pkg> $ln" \n
continue
}
if {[string match "Tests ended at*" $ln]} {
#review - what outputs this?
#puts stdout "<stdout><$pkg> $ln"
@ -153,6 +220,19 @@ tcl::namespace::eval punk::tcltestrun {
dict set test_case_fail stage open
set line_inner [string range $ln 5 end-7] ;#trim leading ====<space> and trailing <space>FAILED
dict set test_case_fail test_openingtext $line_inner
} elseif {$current_start_name ne "" && [string match "==== *" $ln]
&& [string equal -length [string length "$current_start_name "] "$current_start_name " [string range $ln 5 end]]} {
#G-161: entry point to a MULTI-LINE opening banner - a line starting
#"==== <current test name> " that does not end " FAILED" is the first
#physical line of a banner whose description contains embedded newlines
#(single tcltest puts; see the banner stage above for the terminator).
#Anchoring on the current started test's name (exact prefix compare, no
#glob) means ordinary output cannot open banner capture, and streams
#without -verbose start events never take this branch - their parsing
#is unchanged.
dict set test_case_fail stage banner
dict set test_case_fail test_openingtext [string range $ln 5 end]
dict set test_case_fail banner_lines 1
}
dict append results out "<stdout><$pkg> $ln" \n
@ -232,7 +312,20 @@ tcl::namespace::eval punk::tcltestrun {
# Result capture for FAILED (non-error) tests: grab "---- Result was:" and "---- Result should have been" blocks.
if {$fail_stage eq "contents"} {
if {[dict exists $test_case_fail result_stage] && [dict get $test_case_fail result_stage] ne ""} {
if {[string match "---- *" $ln] || [string match "==== * FAILED" $ln_trimright] || [string match "++++ *" $ln]} {
if {[string match "---- Result should have been*" $ln]} {
# Direct transition result_was -> result_expected. The two blocks are
# adjacent single puts, so this opener always arrives while the
# result_was capture is still ACTIVE. Before G-161 the line merely
# reset the active capture and the fall-through skipped the opener
# elseif below: result_expected was never captured (absent from every
# report) and the expected-value lines leaked into test_body.
dict set test_case_fail result_stage "result_expected"
if {![dict exists $test_case_fail result_expected]} {
dict set test_case_fail result_expected ""
}
dict append results out "<stdout><$pkg> $ln" \n
continue
} elseif {[string match "---- *" $ln] || [string match "==== * FAILED" $ln_trimright] || [string match "++++ *" $ln]} {
dict set test_case_fail result_stage ""
# fall through to normal handling below (do not continue)
} else {
@ -304,6 +397,7 @@ tcl::namespace::eval punk::tcltestrun {
dict unset test_case_fail result_was
dict unset test_case_fail result_expected
dict unset test_case_fail result_stage
dict unset test_case_fail banner_lines
dict append results out "<stdout><$pkg> $ln" \n
continue ;#skip to next line.
@ -543,7 +637,7 @@ namespace eval ::punk::args::register {
package provide punk::tcltestrun [tcl::namespace::eval punk::tcltestrun {
variable pkg punk::tcltestrun
variable version
set version 0.3.1
set version 0.4.0
}]
return

72
src/bootsupport/modules/shellfilter-0.2.4.tm → src/bootsupport/modules/shellfilter-0.2.5.tm
Unescape View File

@ -419,7 +419,10 @@ namespace eval shellfilter::chan {
}
method initialize {transform_handle mode} {
#return [list initialize read drain write flush clear finalize]
return [list initialize write flush clear finalize]
#'clear' deliberately NOT declared: when a transform declares it, the core
#delivers a 'clear' op before EVERY write (tclIORTrans.c ReflectOutput), not
#just on seek - see goals/archive/G-145-piped-usage-ansi-remnants.md.
return [list initialize write flush finalize]
}
method finalize {transform_handle} {
#Note that an error in the finalize can stop 'chan pop' from running properly.
@ -430,8 +433,15 @@ namespace eval shellfilter::chan {
# must be present but we ignore it because we do not
# post any events
}
#G-145 defect class: 'clear' must NOT discard o_encbuf (held partial multi-byte
#character). With clear declared, the core calls it before every write; dropping
#the carry leaves the next chunk starting with orphan continuation bytes, making
#whole chunks unconvertible - they accumulate in o_encbuf and successive clears
#discard them, eating contiguous ranges of multibyte-dense output (the 2026-08-03
#unix repl result-echo corruption). Kept as a state-preserving no-op in case
#'clear' is ever re-declared; this write-only transform has no read-side state
#(the documented scope of 'clear').
method clear {transform_handle} {
set o_encbuf ""
return
}
#method drain {transform_handle} {
@ -471,16 +481,22 @@ namespace eval shellfilter::chan {
# return $clear
#}
method flush {transform_handle} {
set clear $o_buffered$o_encbuf
if {[catch {tcl::encoding::convertfrom $o_enc $clear} stringdata]} {
#if we can't convert the buffer contents to a string - does it make sense to emit the raw bytes?
# - probably not.
#REVIEW?
#this class holds only o_encbuf (raw bytes of a trailing incomplete
#multi-byte character) - there is no o_buffered ansi-carry here (that
#belongs to the ansiwrap/ansistrip style transforms).
#An incomplete char is not decodable on its own: hold it for the next write
#rather than emitting garbage or discarding (G-145: dropping held stream
#state corrupts content split across write chunks). finalize dropping it at
#true end of stream is acceptable.
if {$o_encbuf eq ""} {
return ""
}
if {[catch {tcl::encoding::convertfrom $o_enc $o_encbuf} stringdata]} {
return ""
}
set o_buffered ""
set o_encbuf ""
return $stringdata
puts -nonewline $o_localchan $stringdata
return [tcl::encoding::convertto $o_enc $stringdata]
}
method write {transform_handle bytes} {
#set logdata [tcl::encoding::convertfrom $o_enc $bytes]
@ -570,16 +586,19 @@ namespace eval shellfilter::chan {
# return $clear
#}
method flush {transform_handle} {
set clear $o_buffered$o_encbuf
if {[catch {tcl::encoding::convertfrom $o_enc $clear} stringdata]} {
#if we can't convert the buffer contents to a string - does it make sense to emit the raw bytes?
# - probably not.
#REVIEW?
#only o_encbuf exists in this class (no o_buffered ansi-carry as in ansiwrap).
#An incomplete multi-byte char is not decodable on its own: hold it for the
#next write rather than discarding (G-145: dropping held stream state
#corrupts content split across write chunks).
if {$o_encbuf eq ""} {
return ""
}
if {[catch {tcl::encoding::convertfrom $o_enc $o_encbuf} stringdata]} {
return ""
}
set o_buffered ""
set o_encbuf ""
return $stringdata
::shellfilter::log::write $o_logsource $stringdata
return [tcl::encoding::convertto $o_enc $stringdata]
}
method write {ch bytes} {
#set logdata [tcl::encoding::convertfrom $o_enc $bytes]
@ -668,16 +687,19 @@ namespace eval shellfilter::chan {
# return
#}
method flush {transform_handle} {
set clear $o_buffered$o_encbuf
if {[catch {tcl::encoding::convertfrom $o_enc $clear} stringdata]} {
#if we have data in the buffer that we haven't been able to convert to a string
#- then we probably have some kind of encoding mismatch. Is it safer to discard it than to emit garbage chars to the log?
#REVIEW. - we are writing the raw bytes to the log here because we can't convert them to a string.
#This may be useful for debugging issues, but it may also result in garbage data in the log.
::shellfilter::log::write $o_logsource $o_encbuf
#only o_encbuf exists in this class (no o_buffered ansi-carry as in ansiwrap).
#logonly emits nothing downstream. An incomplete multi-byte char is not
#decodable on its own: hold it for the next write rather than discarding
#(G-145: dropping held stream state corrupts content split across write
#chunks); if it decodes anyway (e.g after an encoding change), log it now.
if {$o_encbuf eq ""} {
return ""
}
if {![catch {tcl::encoding::convertfrom $o_enc $o_encbuf} stringdata]} {
::shellfilter::log::write $o_logsource $stringdata
set o_encbuf ""
}
return
return ""
}
method write {transform_handle bytes} {
#set logdata [encoding convertfrom $o_enc $bytes]
@ -3838,5 +3860,5 @@ namespace eval shellfilter {
package provide shellfilter [namespace eval shellfilter {
variable version
set version 0.2.4
set version 0.2.5
}]
Write Preview
Loading…
Cancel
Save