diff --git a/goals/G-118-tclsh-subcommand-review.md b/goals/G-118-tclsh-subcommand-review.md index 00a4e143..2e195d11 100644 --- a/goals/G-118-tclsh-subcommand-review.md +++ b/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 ' 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. diff --git a/src/tests/AGENTS.md b/src/tests/AGENTS.md index 2b3bd654..318552a2 100644 --- a/src/tests/AGENTS.md +++ b/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 ` 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 ` 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 (agent[, G-])[ - ]`. 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 diff --git a/src/tests/shell/AGENTS.md b/src/tests/shell/AGENTS.md index 0d1cf492..baea002b 100644 --- a/src/tests/shell/AGENTS.md +++ b/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:` 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 ` 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 `/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. diff --git a/src/tests/shell/testsuites/punkexe/tclshcmd.test b/src/tests/shell/testsuites/punkexe/tclshcmd.test index 4d888564..4195005e 100644 --- a/src/tests/shell/testsuites/punkexe/tclshcmd.test +++ b/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 #/bin/punk902z.exe, else /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 + #' 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 ' 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 , out , err , inject . + 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. diff --git a/src/tests/testsupport/consoleinject.ps1 b/src/tests/testsupport/consoleinject.ps1 new file mode 100644 index 00000000..f534f4e5 --- /dev/null +++ b/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 -TextFile +# stdout: 'INJECT-OK lines=N' on success, 'INJECT-FAIL rc=<1|2|3> lasterr=' 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