Browse Source

G-118 item 11: env-gated hidden-console test for the dorepl console-reopen path

New src/tests/testsupport/consoleinject.ps1: the G-106 recipe's injection
half as a committed helper - FreeConsole/AttachConsole to a target pid's
console, open CONIN$, type lines as WriteConsoleInput key events.

tclshcmd.test: constraint punkconsole (windows + PUNK_TEST_CONSOLE=1; normal
runs skip) gates two tests driving the reopen path end-to-end in the child's
OWN hidden console (outer Start-Process -WindowStyle Hidden wrapper owns a
fresh console; wrapper runs '<kit> tclsh' there with std handles redirected
to files; piped code sets dorepl; injected lines + exit 0 finish it).
Pinned: reopened flips 0 -> 1 at reopen with istty immutable at 0,
inputbuffer published empty, reopen notice silent by default and STDERR-only
under TCLSH_PIPEREPL_DEBUG=1, injected exit completes with code 0 - closing
the item-1/7 console-side residue. Deadlines + wrapper-tree kill keep the
tests hang-proof; the piped-harness HANG RULE stands for everything else.

Verified: PUNK_TEST_CONSOLE=1 run 21/21 against punk9_beta; normal run
19 pass + 2 console skips; shell/*** suite 64 pass / 4 skips / 0 fail.
AGENTS updates: src/tests/shell (tclshcmd bullet - coverage now exists,
refined hang rule), src/tests (testsupport index + .ps1 helpers wording).

Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
Julian Noble 3 days ago
parent
commit
83d2c6f44c
  1. 20
      goals/G-118-tclsh-subcommand-review.md
  2. 2
      src/tests/AGENTS.md
  3. 2
      src/tests/shell/AGENTS.md
  4. 191
      src/tests/shell/testsuites/punkexe/tclshcmd.test
  5. 84
      src/tests/testsupport/consoleinject.ps1

20
goals/G-118-tclsh-subcommand-review.md

@ -64,4 +64,22 @@ All 11 items dispositioned by the user 2026-07-24 (activation session). Items 1
Verified: usage-first render in fresh interp (real_id path), src + rebuilt-kit
(punk902z script probe: 0.1.0, 5298-char tclsh render) + repl-wired (piped punk
session renders (script)::punkexe without manual require).
- Remaining for acceptance: console-driven test (item 11).
- 2026-07-25 item 11 LANDED: env-gated console-driven coverage of the dorepl
console-reopen path (tclshcmd.test tests tclsh_cr_reopen_state +
tclsh_cr_reopen_debug_notice, constraint punkconsole = windows + env
PUNK_TEST_CONSOLE=1 so normal runs skip; new committed helper
src/tests/testsupport/consoleinject.ps1 = the G-106 recipe's injection half:
FreeConsole/AttachConsole + CONIN$ WriteConsoleInput key events). Harness shape:
outer powershell Start-Process -WindowStyle Hidden gives an inner wrapper its own
fresh console; the wrapper runs '<kit> tclsh' there with std handles redirected to
files; piped code sets dorepl; injection types the verification lines + exit 0.
Verified live against punk9_beta (PUNK_TEST_CONSOLE=1 run 21/21): CRPHASE1 0 0 1
(istty 0, reopened 0, dorepl set) -> CRPHASE2 0 1 1 (reopened FLIPPED to 1, istty
still 0 - immutable launch fact) + CRPHASE2BUF 0 (inputbuffer published empty),
stderr free of the reopen notice by default, notice present on STDERR only (not
stdout) under TCLSH_PIPEREPL_DEBUG=1, injected exit gives exit code 0. This closes
the item-1/7 console-side residue (notice silence + reopened flip). Hang-proofing:
deadlines + taskkill /T on the test's own wrapper tree; the piped-harness HANG RULE
stands for non-gated tests (tclshcmd.test header + src/tests/shell/AGENTS.md
updated; consoleinject.ps1 indexed in src/tests/AGENTS.md).
- Remaining for acceptance: none - all 11 items dispositioned and landed/documented.

2
src/tests/AGENTS.md

@ -35,7 +35,7 @@ Top-level test harness and source-tree tests for ShellSpy/Punk. Tests here exerc
- Human-facing pass/fail/warning indicators in markdown/compact reports are ANSI-coloured only when stdout is a real windows console (`-colour auto` default: twapi `GetConsoleMode` on the STD_OUTPUT handle as the isatty-equivalent - `get_console_handle` is unsuitable, it succeeds for piped children of console shells; `NO_COLOR` honoured; `-colour on|off` overrides). Machine-facing output (the `RUNTESTS_RESULT` line, json reports) is never coloured, and piped/redirected output stays plain for agents. The runner uses raw literal SGR rather than `a+`/`a` so its indicators are independent of punk::console's process-global colour state.
- ERROR-status failures now surface `errorInfo` (full Tcl error message/stack trace) in markdown, compact, and json reports. Compact mode truncates to a single line.
- FAILED-status failures (result mismatch, not error) now surface `result_was` (actual) and `result_expected` (expected) in markdown, compact, and json reports. Compact mode truncates each to a single line.
- `testsupport/` holds helper `.tcl` files sourced or exec'd by `.test` files or the runner (not discovered as suites). `testsupport/child_test_runner.tcl` is the multi-process-mode bootstrap `runtests.tcl` execs per test file (see the multi-process bullets above). `testsupport/discovery.tcl` is the discovery walk + path-targeting filter sourced by `runtests.tcl` (parent side, before children exist) and by the runner-targeting regression suite (see the discovery bullets above). `testsupport/repl_console_driver.tcl` (G-001) is exec'd in a child tclsh by `modules/punk/repl/testsuites/repl/consolebackends.test`: an interactive repl cannot run inside the shared testinterp (the codethread's quit/exit callbacks thread::send to the thread's MAIN interp, bypassing a child testinterp), so repl-through-console verification always drives a child process. `testsupport/wslprobe.tcl` (G-059) provides `::punktest::wsl`: a memoized capability probe yielding the `wsllinux` constraint (default distro launches, answers uname/tool probes, and round-trips a file through a native tempdir - NOT mere wsl.exe existence) plus native-filesystem staging helpers (`staging_create`/`staging_copy_in`/`run_in`/`staging_cleanup`). WSL-gated tests must execute from a staging dir on the distro's native filesystem with the shared `/mnt` path used only for one-way copy-in/out - never operate on the Windows checkout from inside WSL (DrvFs is slow and cross-boundary stat differences make git re-hash its index and fossil see phantom changes). Probe invocations use `wsl -e <cmd>` only (`wsl --status`/`-l` emit UTF-16). Known limitation: a broken-but-present WSL that hangs (rather than errors) on `wsl -e` can stall the probe.
- `testsupport/` holds helper files (`.tcl`, `.ps1`) sourced or exec'd by `.test` files or the runner (not discovered as suites). `testsupport/child_test_runner.tcl` is the multi-process-mode bootstrap `runtests.tcl` execs per test file (see the multi-process bullets above). `testsupport/discovery.tcl` is the discovery walk + path-targeting filter sourced by `runtests.tcl` (parent side, before children exist) and by the runner-targeting regression suite (see the discovery bullets above). `testsupport/repl_console_driver.tcl` (G-001) is exec'd in a child tclsh by `modules/punk/repl/testsuites/repl/consolebackends.test`: an interactive repl cannot run inside the shared testinterp (the codethread's quit/exit callbacks thread::send to the thread's MAIN interp, bypassing a child testinterp), so repl-through-console verification always drives a child process. `testsupport/wslprobe.tcl` (G-059) provides `::punktest::wsl`: a memoized capability probe yielding the `wsllinux` constraint (default distro launches, answers uname/tool probes, and round-trips a file through a native tempdir - NOT mere wsl.exe existence) plus native-filesystem staging helpers (`staging_create`/`staging_copy_in`/`run_in`/`staging_cleanup`). WSL-gated tests must execute from a staging dir on the distro's native filesystem with the shared `/mnt` path used only for one-way copy-in/out - never operate on the Windows checkout from inside WSL (DrvFs is slow and cross-boundary stat differences make git re-hash its index and fossil see phantom changes). Probe invocations use `wsl -e <cmd>` only (`wsl --status`/`-l` emit UTF-16). Known limitation: a broken-but-present WSL that hangs (rather than errors) on `wsl -e` can stall the probe. `testsupport/consoleinject.ps1` (G-118 item 11) is the G-106 hidden-console recipe's injection half as a committed helper: it FreeConsole/AttachConsole's to a target pid's console, opens `CONIN$` and types lines as WriteConsoleInput key events - used by `shell/testsuites/punkexe/tclshcmd.test`'s env-gated console-reopen tests (any process attached to the target console works as the pid, e.g. a wrapper that launched the real target with redirected std handles).
- Test provenance comments: an agent adding a test places one comment line directly above it — or one line above a contiguous group added in the same piece of work — of the form `#added <YYYY-MM-DD> (agent[, G-<id>])[ - <short note>]`. Date and the `agent` marker are mandatory; the goal reference is mandatory when a goal motivated the test; the note is optional (omit it when the test name/description already says why the test exists). Provenance lines record immutable facts only — never expectations such as "G-NNN will flip this" (that state lives in `_GAP_`-style test names and the owning goal's files). User-added tests may use the same form with `(user)` but are not required to. Do not retrofit existing suites in bulk; add provenance opportunistically when editing a file. Rationale: provenance must survive where VCS history does not travel — packaged test modules (G-029), the git+fossil dual history, and file regeneration/moves.
## Work Guidance

2
src/tests/shell/AGENTS.md

@ -20,7 +20,7 @@ Tests for shell-level behavior, command-line execution, and stdin/stdout interac
- `testsuites/punkexe/shellnavns.test` proves the namespace-navigation session contract end-to-end over a piped 'src'-mode session (dev modules - deliberate, so current punk::repl/nav source is exercised without a rebuild): n/ sets ns_current, the current namespace continues into `subshell punk` and back out (currently via the documented first-subshell shared-code-interp asymmetry - the SHARED marker pins it; the repl::start seeding template for genuinely separate interps is proven in modules/punk/repl nscurrent.test), the punk::repl 0.5.2 stray-namespace fix holds live, and the session exits cleanly. KNOWN GAP pinned there: piped submissions evaluate at :: despite ns_current (interactive and module-level inscope behaviour differ) - investigate alongside G-038.
- `testsuites/punkexe/scriptexec.test` covers the `script` subcommand (app-punkscript, G-015): piped execution + honest exit codes, result echo, file-form argv, the `lib:<name>` scriptlib-resolution mechanism (incl. punk::path 0.3.0 extensionless-tcl matching: first-line identification, called-spelling precedence over a `.tcl` sibling, sh-trampoline shebang acceptance, and the non-tcl skip note on not-found), and the tclsh-matching Tk main-loop behaviour. The `lib:` and Tk cases resolve committed fixtures under `scriptlib/_punktest/` (test-owned; a `lib:`-resolvable fixture cannot live in a tcltest temp dir since resolution only searches scriptlib locations relative to the exe). Tk cases are gated by the `punktk` constraint, auto-detected by probing whether the kit can load Tk.
- punkexe tests run against the built binary: after changing punk::repl or app-punkshell source, rebuild via `make.tcl packages`, `make.tcl vfscommonupdate -confirm 0` (unattended runs must pass the flag - the REPLACE confirmation aborts fast on non-interactive stdin instead of reading a piped `y`), then `make.tcl project` before trusting results; `make.tcl project` alone does not refresh `_vfscommon.vfs`.
- `testsuites/punkexe/tclshcmd.test` covers the `tclsh` subcommand (punk_main.tcl dispatch): script-file sourcing (argv0/argv/info-script state, honest exit codes incl. explicit exit), piped no-arg stdin evaluation, stock argument forms (leading `-` arg = no script, all args stay in `::argv`; `-encoding name file` sources with the named encoding, incomplete `-encoding` forms fall through to argv; verified byte-level via a utf-8/iso8859-1 fixture), the `lib:` refusal (plain-tclsh semantics - pointer to the `script` subcommand, exit 1), and - on kits built on a TCLSH_PIPEREPL-patched runtime (G-096/G-103, see `src/buildsuites/suite_tcl90/patches/README.md`) - the piperepl launch-state contract: ::tclsh(istty) published, piped script-arg launch state all-zero, unconsumed piped input NOT evaluated unless the script sets `::tclsh(evalinput) 1`, and the script's right to consume stdin itself; plus the degraded-mode notice on unpatched runtimes. Patched-kit resolution: `env(PUNK_PIPEREPL_TEST_EXE)` if it probes as patched, else the punkexe if patched, else `bin/punk9_beta.exe`/`bin/punk9bi_beta.exe`. HANG RULE: no test or fixture may set `::tclsh(dorepl)` - that path reopens stdin from the console (CONIN$) and blocks under this piped harness; console-reopen coverage needs the G-106 hidden-console recipe and is deliberately absent.
- `testsuites/punkexe/tclshcmd.test` covers the `tclsh` subcommand (punk_main.tcl dispatch): script-file sourcing (argv0/argv/info-script state, honest exit codes incl. explicit exit), piped no-arg stdin evaluation, stock argument forms (leading `-` arg = no script, all args stay in `::argv`; `-encoding name file` sources with the named encoding, incomplete `-encoding` forms fall through to argv; verified byte-level via a utf-8/iso8859-1 fixture), the `lib:` refusal (plain-tclsh semantics - pointer to the `script` subcommand, exit 1), and - on kits built on a TCLSH_PIPEREPL-patched runtime (G-096/G-103, see `src/buildsuites/suite_tcl90/patches/README.md`) - the piperepl launch-state contract: ::tclsh(istty) published, piped script-arg launch state all-zero, unconsumed piped input NOT evaluated unless the script sets `::tclsh(evalinput) 1`, and the script's right to consume stdin itself; plus the degraded-mode notice on unpatched runtimes. Patched-kit resolution: `env(PUNK_PIPEREPL_TEST_EXE)` if it probes as patched, else the punkexe if patched, else `bin/punk9_beta.exe`/`bin/punk9bi_beta.exe`. HANG RULE: no PIPED test or fixture may set `::tclsh(dorepl)` - that path reopens stdin from the console (CONIN$) and blocks under the piped punk_run harness. Console-reopen coverage exists but is env-gated (G-118 item 11; constraint `punkconsole` = windows + env `PUNK_TEST_CONSOLE=1`, normal runs skip): two tests drive the dorepl path end-to-end in the child's OWN hidden console per the G-106 recipe - an outer `Start-Process -WindowStyle Hidden` powershell wrapper owns a fresh console and runs `<kit> tclsh` there with std handles redirected to files, then `testsupport/consoleinject.ps1` attaches to that console and types the verification lines + `exit 0` as key events. They pin: `::tclsh(reopened)` flips 0 -> 1 at reopen while `istty` stays 0 (immutable launch fact), `::tclsh(inputbuffer)` appears empty (the repl loop consumed all piped input), the reopen notice is silent by default and appears on STDERR only under `TCLSH_PIPEREPL_DEBUG=1`, and the injected exit completes the process (exit code 0). Deadlines plus wrapper-tree kill keep them hang-proof.
- `testsuites/binscripts/runtimebash_wsl.test` (G-059) exercises the punk-runtime.cmd unix payload (`src/scriptapps/bin/punk-runtime.bash`) through WSL: active/use/run resolution, env override, stale-active guidance, single-candidate fallback, and `list -remote` local-vs-server comparison (offline via a crafted cached sha1sums.txt + `PUNKBIN_URL` pointed at an unreachable address). Gated by the `wsllinux` capability constraint from `src/tests/testsupport/wslprobe.tcl`; all execution happens in a WSL-native staging dir, and a final test asserts the Windows checkout's git status is unchanged by the run.
- `testsuites/punkexe/staticruntime.test` (G-058) targets a kit built on a runtime with statically-linked packages: resolved from `env(PUNK_STATICKIT_TEST_EXE)`, else `<projectroot>/bin/punk91.exe`, gated by the capability-probed `statickitavailable` constraint (a probe run must show a captured `::punkboot::static_packages` baseline including Thread - not mere file existence). It asserts repl boot without the codethread Thread failure, Thread resolution in the code interp / fabricated interps / snapshot-seeded threads, and twapi resolution per the static-vs-bundled policy. The verification runtime (tclsfe-x64.exe) is pinned in the punkbin artifact repo so the constraint is satisfiable off the original dev machine. Kit script-exec paths must be passed with forward slashes.
- GOAL tests (constraint `punkgoals`, enabled by env `PUNK_TEST_GOALS=1`) cover the piped-stdin-then-interactive-shell drop-in (`shellpipe_eof_then_interactive_shell`, `shellpipe_script_and_eof_then_interactive_shell`); they are excluded from normal runs because they require an openable console in the test environment and briefly attach a live shell to it - they pass in console-attached environments against a current build.

191
src/tests/shell/testsuites/punkexe/tclshcmd.test

@ -15,12 +15,23 @@ package require tcltest
# (istty 0, tcl_interactive 0, dorepl 0, evalinput 0), unconsumed piped input NOT
# evaluated by default (safety default), ::tclsh(evalinput) opt-in evaluating
# leftover input after the script, and the script's right to consume stdin itself.
# Env-gated (PUNK_TEST_CONSOLE=1, windows): the dorepl console-reopen path itself -
# piped input sets dorepl, stdin eof reopens CONIN$ in the child's own hidden
# console, ::tclsh(reopened) flips 0 -> 1 while istty stays 0 (immutable launch
# fact), ::tclsh(inputbuffer) appears (empty - the repl loop consumed all piped
# input), the reopen notice is silent by default and appears on STDERR only under
# TCLSH_PIPEREPL_DEBUG=1, and an injected 'exit 0' ends the reopened repl cleanly.
#
#HANG SAFETY: no test or fixture ever sets ::tclsh(dorepl) - that is the console-reopen
#path (stdin reopened from CONIN$ at eof), which blocks on a real console and cannot be
#driven by this piped harness (needs the hidden-console/WriteConsoleInput recipe, G-106).
#All children here terminate at stdin EOF by construction; punk_run force-kills on
#timeout regardless.
#HANG SAFETY: no PIPED test or fixture ever sets ::tclsh(dorepl) - that is the
#console-reopen path (stdin reopened from CONIN$ at eof), which blocks on a real console
#and cannot be driven by the piped punk_run harness. All punk_run children terminate at
#stdin EOF by construction; punk_run force-kills on timeout regardless.
#The SANCTIONED exception is the env-gated console-reopen section at the bottom
#(constraint punkconsole, env PUNK_TEST_CONSOLE=1; G-118 item 11): those tests run the
#target in its OWN hidden console (G-106 recipe: Start-Process hidden + AttachConsole/
#WriteConsoleInput via testsupport/consoleinject.ps1), drive the reopened repl to 'exit'
#by injected keystrokes, and tree-kill the console wrapper on deadline - the piped
#harness and the runner's console are never involved.
#
#Dispatch tests target the standard punkexe: env(PUNK_SHELL_TEST_EXE), else
#<projectroot>/bin/punk902z.exe, else <projectroot>/bin/punkshell902 (constraint
@ -408,5 +419,175 @@ puts "PRGOT:[string trim $d]"} pr_consume.tcl]
lappend result [dict get $rd exitcode]
} -result [list 0 1 1 0]
# -- console-reopen path (env-gated hidden-console harness, G-118 item 11) ---------------------
#
#The G-106 recipe: the target runs in its OWN hidden console (outer powershell
#Start-Process -WindowStyle Hidden of an inner powershell wrapper; the wrapper starts
#'<exe> tclsh' with std handles redirected to files, sharing the wrapper's fresh
#console). Piped-in code sets ::tclsh(dorepl) 1, so stdin eof reopens CONIN$ of that
#hidden console; testsupport/consoleinject.ps1 then attaches to the wrapper's console
#and types the verification lines + 'exit 0' as key events. Deadlines everywhere; on
#timeout the wrapper's process tree (wrapper + target - our own children) is killed.
#Normal runs skip: constraint punkconsole requires env PUNK_TEST_CONSOLE=1 (windows).
testConstraint punkconsole [expr {
$::tcl_platform(platform) eq "windows"
&& [info exists ::env(PUNK_TEST_CONSOLE)] && $::env(PUNK_TEST_CONSOLE) eq "1"
}]
variable wkc 0
proc wait_ms {ms} {
variable wkc
set var [namespace current]::__wk[incr wkc]
after $ms [list set $var 1]
vwait $var
unset $var
}
#single-quoted powershell string literal
proc psq {s} {
return "'[string map {' ''} $s]'"
}
#Run '<exe> tclsh' in its own hidden console with piped stdin that sets dorepl,
#inject verification lines + exit into the reopened console, collect the redirected
#output/error files. Returns dict: phase1seen 0|1, injected 0|1, completed 0|1,
#donecode <exitcode|"">, out <stdout text>, err <stderr text>, inject <helper output>.
proc console_reopen_run {exe prefix {debugenv 0}} {
variable projectroot
set tmp [file normalize [tcltest::temporaryDirectory]]
set f_in [file join $tmp ${prefix}_in.txt]
set f_out [file join $tmp ${prefix}_out.txt]
set f_err [file join $tmp ${prefix}_err.txt]
set f_pid [file join $tmp ${prefix}_pid.txt]
set f_done [file join $tmp ${prefix}_done.txt]
set f_lines [file join $tmp ${prefix}_lines.txt]
set f_inner [file join $tmp ${prefix}_inner.ps1]
set f_outer [file join $tmp ${prefix}_outer.ps1]
foreach f [list $f_out $f_err $f_pid $f_done] { file delete -force $f }
#stdin fixture: set dorepl (the sanctioned exception - own console, injected exit,
#tree-kill fallback) and report gate-open launch state; eof then reopens the console
set fd [open $f_in w]
chan configure $fd -translation lf
puts $fd {set ::tclsh(dorepl) 1}
puts $fd {puts [list CRPHASE1 $::tclsh(istty) $::tclsh(reopened) $::tclsh(dorepl)]}
close $fd
#lines typed into the reopened console repl
set fd [open $f_lines w]
chan configure $fd -translation lf
puts $fd {puts [list CRPHASE2 $::tclsh(istty) $::tclsh(reopened) [info exists ::tclsh(inputbuffer)]]}
puts $fd {catch {puts [list CRPHASE2BUF [string length $::tclsh(inputbuffer)]]}}
puts $fd {exit 0}
close $fd
#inner wrapper: owns the fresh hidden console; records its pid (the injection
#target - any process attached to the console works), optionally sets the patch
#debug env, runs the target sharing this console with std handles redirected
set inner ""
append inner "Set-Content -LiteralPath [psq $f_pid] -Value \$PID" \n
if {$debugenv} {
append inner "\$env:TCLSH_PIPEREPL_DEBUG = '1'" \n
}
append inner "\$p = Start-Process -FilePath [psq $exe] -ArgumentList 'tclsh' -RedirectStandardInput [psq $f_in] -RedirectStandardOutput [psq $f_out] -RedirectStandardError [psq $f_err] -NoNewWindow -Wait -PassThru" \n
append inner "Set-Content -LiteralPath [psq $f_done] -Value \$p.ExitCode" \n
set fd [open $f_inner w]
chan configure $fd -translation crlf
puts -nonewline $fd $inner
close $fd
#outer: the shell-execute launch giving the inner wrapper its own (hidden) console
set fd [open $f_outer w]
chan configure $fd -translation crlf
puts $fd "Start-Process -FilePath powershell.exe -ArgumentList '-NoProfile','-ExecutionPolicy','Bypass','-File',[psq "\"$f_inner\""] -WindowStyle Hidden"
close $fd
exec {*}[auto_execok powershell] -NoProfile -ExecutionPolicy Bypass -File $f_outer
set rd [dict create phase1seen 0 injected 0 completed 0 donecode "" out "" err "" inject ""]
set deadline [expr {[clock milliseconds] + 15000}]
set innerpid ""
while {[clock milliseconds] < $deadline} {
if {[file exists $f_pid]} {
catch {
set pfd [open $f_pid r]
set innerpid [string trim [read $pfd]]
close $pfd
}
if {[string is integer -strict $innerpid]} break
set innerpid ""
}
wait_ms 150
}
if {$innerpid ne ""} {
while {[clock milliseconds] < $deadline} {
set outnow ""
catch {
set ofd [open $f_out r]
set outnow [read $ofd]
close $ofd
}
if {[string first CRPHASE1 $outnow] >= 0} {
dict set rd phase1seen 1
break
}
wait_ms 150
}
}
if {[dict get $rd phase1seen]} {
set injectscript [file join $projectroot src tests testsupport consoleinject.ps1]
set injout ""
if {![catch {exec {*}[auto_execok powershell] -NoProfile -ExecutionPolicy Bypass -File $injectscript -TargetPid $innerpid -TextFile $f_lines} injout]} {
dict set rd injected 1
}
dict set rd inject $injout
}
set deadline2 [expr {[clock milliseconds] + 15000}]
while {[clock milliseconds] < $deadline2} {
if {[file exists $f_done]} {
dict set rd completed 1
break
}
wait_ms 150
}
if {![dict get $rd completed] && $innerpid ne ""} {
#deadline: kill our own wrapper+target tree so the suite cannot hang
catch {exec {*}[auto_execok taskkill] /PID $innerpid /T /F}
}
foreach {key f} [list donecode $f_done out $f_out err $f_err] {
catch {
set rfd [open $f r]
dict set rd $key [string trim [read $rfd]]
close $rfd
}
}
return $rd
}
#added 2026-07-25 (agent, G-118 item 11) - dorepl console-reopen driven end-to-end in a hidden console
test tclsh_cr_reopen_state {console reopen: reopened flips 0 -> 1, istty stays 0, inputbuffer appears empty, no notice by default, injected exit completes}\
-constraints {punkconsole pipereplkitavailable} -setup $common -body {
variable pipereplexe
set rd [console_reopen_run $pipereplexe crplain 0]
lappend result [dict get $rd phase1seen]
lappend result [expr {[string first "CRPHASE1 0 0 1" [dict get $rd out]] >= 0}]
lappend result [expr {[string first "CRPHASE2 0 1 1" [dict get $rd out]] >= 0}]
lappend result [expr {[string first "CRPHASE2BUF 0" [dict get $rd out]] >= 0}]
#the reopen notice must be silent without TCLSH_PIPEREPL_DEBUG (G-118 item 1)
lappend result [expr {[string first "reopen stdin from console" [dict get $rd err]] < 0}]
lappend result [dict get $rd completed]
lappend result [dict get $rd donecode]
} -result [list 1 1 1 1 1 1 0]
test tclsh_cr_reopen_debug_notice {console reopen with TCLSH_PIPEREPL_DEBUG=1: notice on stderr only, state contract unchanged}\
-constraints {punkconsole pipereplkitavailable} -setup $common -body {
variable pipereplexe
set rd [console_reopen_run $pipereplexe crdebug 1]
lappend result [dict get $rd phase1seen]
lappend result [expr {[string first "CRPHASE2 0 1 1" [dict get $rd out]] >= 0}]
lappend result [expr {[string first "reopen stdin from console" [dict get $rd err]] >= 0}]
#the notice is stderr-only - it must not pollute stdout
lappend result [expr {[string first "reopen stdin from console" [dict get $rd out]] < 0}]
lappend result [dict get $rd completed]
lappend result [dict get $rd donecode]
} -result [list 1 1 1 1 1 0]
}
tcltest::cleanupTests ;#needed to produce test summary.

84
src/tests/testsupport/consoleinject.ps1

@ -0,0 +1,84 @@
# consoleinject.ps1 - type lines into the console of another process (windows).
#
# The G-106 hidden-console recipe's injection half, committed for test use (G-118
# item 11 console-reopen coverage in src/tests/shell/testsuites/punkexe/tclshcmd.test):
# detach from our own console (FreeConsole), attach to the target pid's console
# (AttachConsole), open CONIN$ and write key-down/key-up KEY_EVENT records for each
# character of each line plus Enter (VK_RETURN + CR) after every line. Events are
# buffered by the console, so injection may precede the target's console read.
#
# The target pid may be ANY process attached to the target console (e.g. a wrapper
# that launched the real target with redirected std handles in that console).
#
# usage: powershell -NoProfile -ExecutionPolicy Bypass -File consoleinject.ps1 -TargetPid <pid> -TextFile <file>
# stdout: 'INJECT-OK lines=N' on success, 'INJECT-FAIL rc=<1|2|3> lasterr=<winerr>' on failure
# (rc 1 attach failed, 2 CONIN$ open failed, 3 WriteConsoleInput failed); exit code 0/1.
param(
[Parameter(Mandatory=$true)][int]$TargetPid,
[Parameter(Mandatory=$true)][string]$TextFile
)
$ErrorActionPreference = 'Stop'
Add-Type -TypeDefinition @'
using System;
using System.Runtime.InteropServices;
public static class PunkConsoleInject {
[DllImport("kernel32.dll", SetLastError=true)]
public static extern bool FreeConsole();
[DllImport("kernel32.dll", SetLastError=true)]
public static extern bool AttachConsole(uint dwProcessId);
[DllImport("kernel32.dll", SetLastError=true, CharSet=CharSet.Unicode)]
public static extern IntPtr CreateFileW(string lpFileName, uint dwDesiredAccess, uint dwShareMode, IntPtr lpSecurityAttributes, uint dwCreationDisposition, uint dwFlagsAndAttributes, IntPtr hTemplateFile);
[StructLayout(LayoutKind.Sequential, CharSet=CharSet.Unicode)]
public struct KEY_EVENT_RECORD {
public int bKeyDown;
public ushort wRepeatCount;
public ushort wVirtualKeyCode;
public ushort wVirtualScanCode;
public char UnicodeChar;
public uint dwControlKeyState;
}
[StructLayout(LayoutKind.Explicit)]
public struct INPUT_RECORD {
[FieldOffset(0)] public ushort EventType;
[FieldOffset(4)] public KEY_EVENT_RECORD KeyEvent;
}
[DllImport("kernel32.dll", SetLastError=true, CharSet=CharSet.Unicode)]
public static extern bool WriteConsoleInputW(IntPtr hConsoleInput, INPUT_RECORD[] lpBuffer, uint nLength, out uint lpNumberOfEventsWritten);
// returns 0 ok; 1 attach failed; 2 conin open failed; 3 write failed. lastErr = GetLastError of the failing call.
public static int Inject(uint targetPid, string[] lines, out int lastErr) {
lastErr = 0;
FreeConsole();
if (!AttachConsole(targetPid)) { lastErr = Marshal.GetLastWin32Error(); return 1; }
IntPtr h = CreateFileW("CONIN$", 0xC0000000u, 0x3u, IntPtr.Zero, 3u, 0u, IntPtr.Zero);
if (h == (IntPtr)(-1)) { lastErr = Marshal.GetLastWin32Error(); return 2; }
foreach (string line in lines) {
string full = line + "\r";
INPUT_RECORD[] recs = new INPUT_RECORD[full.Length * 2];
int i = 0;
foreach (char c in full) {
ushort vk = (c == '\r') ? (ushort)0x0D : (ushort)0;
KEY_EVENT_RECORD kd = new KEY_EVENT_RECORD();
kd.bKeyDown = 1; kd.wRepeatCount = 1; kd.wVirtualKeyCode = vk;
kd.wVirtualScanCode = 0; kd.UnicodeChar = c; kd.dwControlKeyState = 0;
KEY_EVENT_RECORD ku = kd; ku.bKeyDown = 0;
recs[i].EventType = 1; recs[i].KeyEvent = kd; i++;
recs[i].EventType = 1; recs[i].KeyEvent = ku; i++;
}
uint written;
if (!WriteConsoleInputW(h, recs, (uint)recs.Length, out written)) { lastErr = Marshal.GetLastWin32Error(); return 3; }
}
return 0;
}
}
'@
$lines = @(Get-Content -LiteralPath $TextFile)
$lastErr = 0
$rc = [PunkConsoleInject]::Inject([uint32]$TargetPid, [string[]]$lines, [ref]$lastErr)
if ($rc -ne 0) {
Write-Output "INJECT-FAIL rc=$rc lasterr=$lastErr"
exit 1
}
Write-Output "INJECT-OK lines=$($lines.Count)"
exit 0
Loading…
Cancel
Save