diff --git a/AGENTS.md b/AGENTS.md index a5b43ce0..12d44f09 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -197,7 +197,7 @@ The project version is fully independent of module versions. A module bump (even - `goals/archive/` — Detail files for achieved/archived goals - Directories agents should not directly modify (no child DOX needed): - `callbacks/` — Experimental shellspy features, user-only - - `scriptlib/` — Shared utilities + manual tests, user-only. EXCEPTIONS: `scriptlib/_punktest/` is test-owned (fixtures for `src/tests/shell/testsuites/punkexe/scriptexec.test`, resolved via `lib:_punktest/`); agents may manage that subfolder as part of test work. `scriptlib/developer/` holds agent-authored developer showcase/demo apps and developer utility scripts (created at user request 2026-07-11, e.g `tkconsole_demo.tcl` for the G-001 tk console backend, `goals_lint.tcl` for the goals doc contracts per goals/AGENTS.md Verification, `whatis.tcl` runtime command introspection backing the `tcl-whatis` agent skill); agents may add or update entries there when the user asks for one. The rest of `scriptlib/` stays user-only. + - `scriptlib/` — Shared utilities + manual tests, user-only. EXCEPTIONS: `scriptlib/_punktest/` is test-owned (fixtures for `src/tests/shell/testsuites/punkexe/scriptexec.test`, resolved via `lib:_punktest/`); agents may manage that subfolder as part of test work. `scriptlib/developer/` holds agent-authored developer showcase/demo apps and developer utility scripts (created at user request 2026-07-11, e.g `tkconsole_demo.tcl` for the G-001 tk console backend, `goals_lint.tcl` for the goals doc contracts per goals/AGENTS.md Verification, `whatis.tcl` runtime command introspection backing the `tcl-whatis` agent skill, `runtests_parity.tcl` comparing `runtests.tcl -report json` outputs for result parity between runner modes per src/tests/AGENTS.md Verification); agents may add or update entries there when the user asks for one. The rest of `scriptlib/` stays user-only. - `bin/` — Built binaries and helpers, build output target. This includes the polyglot `.cmd` launcher/utility scripts (e.g `bin/runtime.cmd`): they are GENERATED by the punk::mix scriptwrap machinery from sources under `src/scriptapps/` — a request to "fix bin/.cmd" means editing `src/scriptapps/.*` + `_wrap.toml` and re-wrapping (see bin/AGENTS.md), never editing the output - `modules/` (root) — Build output target for `tclsh src/make.tcl modules` - `lib/` (root) — Build output target for `tclsh src/make.tcl libs` diff --git a/scriptlib/developer/runtests_parity.tcl b/scriptlib/developer/runtests_parity.tcl new file mode 100644 index 00000000..4d872093 --- /dev/null +++ b/scriptlib/developer/runtests_parity.tcl @@ -0,0 +1,326 @@ +#runtests_parity.tcl - compare two 'src/tests/runtests.tcl -report json' outputs for result parity. +#(agent-authored developer utility, 2026-07-18 - created for the -singleproc 0 multi-process +# runner completion: verifies per-file result parity between runner modes/interpreters/contexts) +# +#Usage: +# tclsh scriptlib/developer/runtests_parity.tcl +# +#Each input file is the captured stdout of a runtests.tcl run with -report json (or +#markdown+json): the last line starting with {"runner" is taken as the report, so preamble +#lines (argv echo, package-load warnings) and fenced markdown context are tolerated. +# +#Compared (deterministic result identity): +# - top-level status and total/passed/skipped/failed tallies +# - the set of test file paths +# - per file: status, total/passed/skipped/failed, failure identities (name+status), +# skip identities (name+reason), warning codes +#Ignored (expected to vary between runs/modes): microseconds, the slowest list, +#observed_* event counts. +# +#Exit codes: 0 = parity, 1 = differences found, 2 = usage or parse error. +#No package dependencies (runs under any tclsh 8.6+); contains a minimal JSON parser +#sufficient for the runner's machine-generated report format. + +namespace eval jsonlite { + variable str "" + variable pos 0 + variable len 0 + + proc parse {text} { + variable str $text + variable pos 0 + variable len [string length $text] + return [parse_value] + } + proc fail {msg} { + variable pos + return -code error "jsonlite parse error at offset $pos: $msg" + } + proc skip_ws {} { + variable str + variable pos + variable len + while {$pos < $len && [string index $str $pos] in [list " " \t \n \r]} { + incr pos + } + } + proc parse_value {} { + variable str + variable pos + variable len + skip_ws + if {$pos >= $len} { + fail "unexpected end of input" + } + switch -- [string index $str $pos] { + \{ {return [parse_object]} + \[ {return [parse_array]} + \" {return [parse_string]} + t { + if {[string range $str $pos $pos+3] ne "true"} {fail "bad literal"} + incr pos 4 + return 1 + } + f { + if {[string range $str $pos $pos+4] ne "false"} {fail "bad literal"} + incr pos 5 + return 0 + } + n { + if {[string range $str $pos $pos+3] ne "null"} {fail "bad literal"} + incr pos 4 + return "" + } + default {return [parse_number]} + } + } + proc parse_object {} { + variable str + variable pos + incr pos ;#consume open brace + set d [dict create] + skip_ws + if {[string index $str $pos] eq "\}"} { + incr pos + return $d + } + while 1 { + skip_ws + if {[string index $str $pos] ne "\""} {fail "expected object key"} + set k [parse_string] + skip_ws + if {[string index $str $pos] ne ":"} {fail "expected : after object key"} + incr pos + dict set d $k [parse_value] + skip_ws + switch -- [string index $str $pos] { + , {incr pos} + \} {incr pos; return $d} + default {fail "expected , or \} in object"} + } + } + } + proc parse_array {} { + variable str + variable pos + incr pos ;#consume open bracket + set out [list] + skip_ws + if {[string index $str $pos] eq "\]"} { + incr pos + return $out + } + while 1 { + lappend out [parse_value] + skip_ws + switch -- [string index $str $pos] { + , {incr pos} + \] {incr pos; return $out} + default {fail "expected , or \] in array"} + } + } + } + proc parse_string {} { + variable str + variable pos + variable len + incr pos ;#consume opening quote + set out "" + while {$pos < $len} { + set q [string first "\"" $str $pos] + set b [string first "\\" $str $pos] + if {$q < 0} { + fail "unterminated string" + } + if {$b < 0 || $q < $b} { + append out [string range $str $pos [expr {$q - 1}]] + set pos [expr {$q + 1}] + return $out + } + append out [string range $str $pos [expr {$b - 1}]] + set pos [expr {$b + 1}] + set e [string index $str $pos] + switch -- $e { + \" {append out \"} + \\ {append out \\} + / {append out /} + b {append out \b} + f {append out \f} + n {append out \n} + r {append out \r} + t {append out \t} + u { + set hex [string range $str $pos+1 $pos+4] + if {[string length $hex] != 4 || ![string is xdigit -strict $hex]} { + fail "bad unicode escape" + } + scan $hex %x cp + append out [format %c $cp] + incr pos 4 + } + default {fail "bad escape sequence \\$e"} + } + incr pos + } + fail "unterminated string" + } + proc parse_number {} { + variable str + variable pos + variable len + set start $pos + while {$pos < $len && [string index $str $pos] in [list - + . e E 0 1 2 3 4 5 6 7 8 9]} { + incr pos + } + set numtext [string range $str $start [expr {$pos - 1}]] + if {$numtext eq "" || ![string is double -strict $numtext]} { + fail "bad number '$numtext'" + } + return $numtext + } +} + +proc load_report {filename} { + if {![file exists $filename]} { + puts stderr "runtests_parity: file not found: $filename" + exit 2 + } + set fd [open $filename r] + set data [read $fd] + close $fd + #the report is the last line containing the open-brace+"runner": marker. The marker may + #not be at line start: the runner's punk ANSI output stack can emit an SGR reset sequence + #on the same line immediately before the JSON, and other preamble/noise lines may precede it. + set marker "\{\"runner\":" + set report_line "" + foreach ln [split $data \n] { + set idx [string first $marker $ln] + if {$idx >= 0} { + set report_line [string trimright [string range $ln $idx end] \r] + } + } + if {$report_line eq ""} { + puts stderr "runtests_parity: no runtests JSON report line (containing \{\"runner\":) found in $filename" + exit 2 + } + if {[catch {jsonlite::parse $report_line} report]} { + puts stderr "runtests_parity: could not parse JSON report in $filename: $report" + exit 2 + } + return $report +} + +proc filemap {report} { + set m [dict create] + foreach tf [dict get $report testfiles] { + dict set m [dict get $tf path] $tf + } + return $m +} + +proc failure_sigs {tf} { + set sigs [list] + foreach f [dict get $tf failures] { + lappend sigs "[dict get $f name] status=[dict get $f status]" + } + return [lsort $sigs] +} + +proc skip_sigs {tf} { + set sigs [list] + foreach s [dict get $tf skips] { + lappend sigs "[dict get $s name] reason=[dict get $s reason]" + } + return [lsort $sigs] +} + +proc warning_sigs {tf} { + set sigs [list] + foreach w [dict get $tf warnings] { + lappend sigs [dict get $w code] + } + return [lsort $sigs] +} + +proc list_diff_lines {label lista listb} { + set lines [list] + foreach item $lista { + if {$item ni $listb} { + lappend lines " $label only in A: $item" + } + } + foreach item $listb { + if {$item ni $lista} { + lappend lines " $label only in B: $item" + } + } + return $lines +} + +lassign $argv filea fileb +if {$filea eq "" || $fileb eq "" || [llength $argv] != 2} { + puts stderr "usage: tclsh runtests_parity.tcl " + puts stderr " where each file is captured stdout of: src/tests/runtests.tcl -report json ..." + exit 2 +} + +set ra [load_report $filea] +set rb [load_report $fileb] + +set diffs [list] +foreach k {status total passed skipped failed} { + set va [dict get $ra $k] + set vb [dict get $rb $k] + if {$va ne $vb} { + lappend diffs "top-level $k: A=$va B=$vb" + } +} + +set ma [filemap $ra] +set mb [filemap $rb] +foreach path [dict keys $ma] { + if {![dict exists $mb $path]} { + lappend diffs "file only in A: $path" + } +} +foreach path [dict keys $mb] { + if {![dict exists $ma $path]} { + lappend diffs "file only in B: $path" + } +} + +foreach path [dict keys $ma] { + if {![dict exists $mb $path]} { + continue + } + set tfa [dict get $ma $path] + set tfb [dict get $mb $path] + set flines [list] + foreach k {status total passed skipped failed} { + set va [dict get $tfa $k] + set vb [dict get $tfb $k] + if {$va ne $vb} { + lappend flines " $k: A=$va B=$vb" + } + } + lappend flines {*}[list_diff_lines failure [failure_sigs $tfa] [failure_sigs $tfb]] + lappend flines {*}[list_diff_lines skip [skip_sigs $tfa] [skip_sigs $tfb]] + lappend flines {*}[list_diff_lines warning [warning_sigs $tfa] [warning_sigs $tfb]] + if {[llength $flines]} { + lappend diffs "file $path:" + lappend diffs {*}$flines + } +} + +puts "runtests parity comparison" +puts "A: $filea" +puts "B: $fileb" +if {[llength $diffs] == 0} { + puts "PARITY: ok (files=[llength [dict keys $ma]] total=[dict get $ra total] passed=[dict get $ra passed] skipped=[dict get $ra skipped] failed=[dict get $ra failed])" + exit 0 +} +foreach d $diffs { + puts "- $d" +} +puts "PARITY: DIFFERS ([llength $diffs] difference lines)" +exit 1 diff --git a/src/tests/AGENTS.md b/src/tests/AGENTS.md index 3af78a97..89022d34 100644 --- a/src/tests/AGENTS.md +++ b/src/tests/AGENTS.md @@ -15,19 +15,21 @@ Top-level test harness and source-tree tests for ShellSpy/Punk. Tests here exerc - `runtests.tcl` is the primary source-tree test entry point; sublevel `all.tcl` files are a legacy pattern and are not required. - Tests use `tcltest` unless a child AGENTS.md documents a different local harness. - `runtests.tcl` excludes `AGENTS.md` and `*.tcl` helper files when discovering `.test` files. -- `runtests.tcl` defaults tcltest `-tmpdir` (the `makeFile`/`makeDirectory` location) to a fresh directory under the system temp area, deleted before exit, so test helper files never land in the source tree (aborted core exec.test runs previously littered `src/tests`). A `-tmpdir` supplied via `-tcltestoptions` overrides this. Applies to single-process mode; multi-process mode does not yet forward tcltest options to child processes. +- `runtests.tcl` defaults tcltest `-tmpdir` (the `makeFile`/`makeDirectory` location) to a fresh directory under the system temp area, deleted before exit, so test helper files never land in the source tree (aborted core exec.test runs previously littered `src/tests`). A `-tmpdir` supplied via `-tcltestoptions` overrides this. Applies to both modes: multi-process mode forwards `-tmpdir` (and all other tcltest options) to child processes via the generated environment payload. - The testinterp auto_path (replaced wholesale) also includes the running kit's internal `lib`/`lib_tcl` trees (zipfs app mount, tclkit `::tcl::kitpath`, cookfs `//cookit:/` — mirroring `src/vfs/_config/punk_main.tcl`), so kit-bundled packages (e.g. tcllib's `tcl::chan::fifo2`, needed by the shellrun harness) resolve when the project tree doesn't supply them. `tclPkgUnknown` scans only an entry plus immediate children, so the kit lib dirs must be explicit entries. No-op under a native tclsh. - The single-process testinterp runs `package prefer latest` so alpha-versioned dev modules (`999999.0a1.0`) are preferred over stable bootsupport/vendored copies on unversioned `package require`. - The testinterp module path includes `src/vendormodules` (and `src/vendormodules_tcl` when present) so vendored dependencies such as `voo` resolve in tests. +- Multi-process mode (`-tcltestoptions {-singleproc 0}`, completed 2026-07-18): each test file runs in a child process of the same executable via `testsupport/child_test_runner.tcl`, driven by a per-run environment payload `runtests.tcl` generates (package prefer latest, test tm paths, auto_path, modpod ifneeded definitions, tcltest options; per-file `-testdir` computed child-side). The child then mirrors the single-process testinterp preload: package require shellrun plus one no-op `shellrun::runx -tcl` call (the testinterp sources test files via runx, whose execution pulls further runtime deps - currently punk::lib). Several existing suites use punk::* commands without a package require of their own and depend on this preload (17 files / 97 tests error without shellrun, a further 7 files / 31 tests without the runx warmup; making suite dependencies explicit so children can go leaner is a candidate cleanup, verifiable with the parity tool below). The bootstrap warms `clock format` before the module-path wipe: first script-level clock use loads msgcat from the runtime's default module paths, which the test module paths do not supply (the single-process testinterp is shielded only by the runtests parent's earlier clock use - a latent gap for any test explicitly requiring msgcat in either mode). +- Multi-process failure classification: a nonzero child exit is reported as a file-level failure (compact/markdown/json carry an ERROR entry with errorcode `CHILDPROCESS exit ` and the child's stderr tail); exit-0 with no tcltest summary line remains the `missing-cleanupTests` warning. Prefer a native tclsh for multi-process runs: children of a kit executable boot via the kit's script dispatch with kit-stamped punk packages preloaded, which can shadow the src dev modules under test (the runner prints a warning). - Tests should run against source modules and libraries from `src/`, not installed packages or root-level build outputs. - Test files must `package require` any extra packages explicitly. - Tcltest files must finish with `tcltest::cleanupTests`; missing cleanup produces a `missing-cleanupTests` runner warning and only untrusted observed testcase events. - tcltest compares the `-body` RETURN VALUE against `-result`. The suite convention of accumulating into `$result` via `lappend` works because `lappend` returns the list — but a body whose last command is a loop (`foreach`, `while`) returns the empty string; end such bodies with an explicit `set result`. - Agent-oriented runner output should use `-report compact -show-passes 0` for focused checks unless detailed Markdown pass lists are needed. -- `-report json` emits a machine-readable final summary, but package-load warnings may still precede it on stdout/stderr. +- `-report json` emits a machine-readable final summary, but package-load warnings may still precede it on stdout/stderr, and the punk ANSI output stack may emit an SGR reset immediately before the JSON on the same line (`scriptlib/developer/runtests_parity.tcl` tolerates both). - 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 (not discovered as suites). `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 `.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/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. - 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 @@ -40,6 +42,7 @@ Top-level test harness and source-tree tests for ShellSpy/Punk. Tests here exerc - Multiple trailing file tails are supported and match independently: `runtests.tcl foo.test bar.test` runs both in one invocation (fixed 2026-07-17; previously multiple names collapsed into one glob matching zero files). - Treat `RUNTESTS_RESULT status=warn` and compact warning reasons such as `missing-cleanupTests` as incomplete test results, even if observed pass events are listed. - Add `-slowest ` when timing outliers are relevant. +- Multi-process runs use `-tcltestoptions {-singleproc 0}` with otherwise identical flags. Check result parity between modes by capturing `-report json` stdout from each and comparing with `tclsh scriptlib/developer/runtests_parity.tcl ` (ignores timings; exit 0 on parity). - Add `-strict-exit 1` when a nonzero shell exit code is needed for failures or parser warnings. - Capture enough stderr or failure context to identify the failing command or assertion. - For ERROR-status failures, the markdown report's `errorInfo` block and compact `message=` field carry the full Tcl error message; use `-report markdown` for untruncated context. @@ -49,6 +52,7 @@ Top-level test harness and source-tree tests for ShellSpy/Punk. Tests here exerc - ` src/tests/runtests.tcl` passes when broad source-tree test coverage is relevant. - Focused checks use ` src/tests/runtests.tcl -report compact -show-passes 0 -include-paths ` and optional file-tail globs. +- Changes to `runtests.tcl` or `testsupport/child_test_runner.tcl` are verified by running the full suite in both modes with `-report json` and confirming `scriptlib/developer/runtests_parity.tcl` reports `PARITY: ok`. - Documentation-only changes are verified by reviewing the affected DOX chain and diff. ## Child DOX Index diff --git a/src/tests/runtests.tcl b/src/tests/runtests.tcl index 128d3361..8331f41a 100644 --- a/src/tests/runtests.tcl +++ b/src/tests/runtests.tcl @@ -264,6 +264,91 @@ proc runtests_print_slowest_tests {slowest_tests show_timings} { puts stdout "" } +proc runtests_text_tail {text maxchars} { + #tail of captured child output for failure reports - whole trailing lines, bounded size + set text [string trimright $text] + if {[string length $text] <= $maxchars} { + return $text + } + set text [string range $text end-[expr {$maxchars - 1}] end] + #drop the leading partial line the cut probably produced (bounded scan so a single + #enormous line can't defeat the truncation marker) + set nl [string first \n $text] + if {$nl >= 0 && $nl < 200} { + set text [string range $text [expr {$nl + 1}] end] + } + return "...(truncated)...\n$text" +} + +proc runtests_create_tempdir {nametag} { + #'file tempdir' requires tcl 8.7+ - fall back to env temp + tagged pid subdir for 8.6 + if {![catch {file tempdir} tdir]} { + return $tdir + } + foreach evar {TMPDIR TEMP TMP} { + if {[info exists ::env($evar)] && [file isdirectory $::env($evar)]} { + set tdir [file join $::env($evar) ${nametag}_[pid]] + file mkdir $tdir + return $tdir + } + } + return "" +} + +proc runtests_write_child_payload {payloadfile test_tmlist test_auto_path ifneeded_script tcltestoptions} { + #environment payload sourced by testsupport/child_test_runner.tcl in each child process. + #Mirrors the singleproc testinterp setup order ('package prefer latest' before anything + #that could package require). + set fd [open $payloadfile w] + puts $fd "#auto-generated by runtests.tcl - child test process environment (see testsupport/child_test_runner.tcl)" + puts $fd {package prefer latest} + puts $fd {tcl::tm::remove {*}[tcl::tm::list]} + puts $fd [list tcl::tm::add {*}$test_tmlist] + puts $fd [list set ::auto_path $test_auto_path] + puts $fd $ifneeded_script + puts $fd [list set ::runtests_child_tcltestoptions $tcltestoptions] + close $fd +} + +proc runtests_run_child_process {exe bootstrap payloadfile testfile outfile errfile} { + #Run one test file in a child process, capturing stdout/stderr to files. Deliberately no + #shellrun/shellfilter capture on the parent side: file capture avoids the parent-stdin/pipe + #machinery, and parallel scheduling (future -jobs) can reuse the same mechanism. (What the + #child itself loads - including its shellrun preload mirroring the singleproc testinterp - + #is the bootstrap's concern; see testsupport/child_test_runner.tcl.) + #stdin is an immediate-EOF redirection so a misbehaving child can't hang on it. + #Returns a dict shaped for punk::tcltestrun::parse_testrun: exitcode/stdout/stderr keys, + #or error/errorCode/errorInfo keys if the child could not be launched at all. + foreach f [list $outfile $errfile] { + if {[file exists $f]} { + file delete -force $f + } + } + set exitcode 0 + if {[catch {exec -- $exe $bootstrap $payloadfile $testfile > $outfile 2> $errfile << {}} emsg errdict]} { + set ecode [dict get $errdict -errorcode] + if {[lindex $ecode 0] eq "CHILDSTATUS"} { + set exitcode [lindex $ecode 2] + } else { + #launch failure (or CHILDKILLED etc) - no usable test run + return [dict create error $emsg errorCode $ecode errorInfo [dict get $errdict -errorinfo]] + } + } + set out "" + set err "" + if {[file exists $outfile]} { + set fd [open $outfile r] + set out [read $fd] + close $fd + } + if {[file exists $errfile]} { + set fd [open $errfile r] + set err [read $fd] + close $fd + } + return [dict create exitcode $exitcode stdout $out stderr $err] +} + @@ -359,7 +444,17 @@ punk::args::define { @opts -tcltestoptions -type dict -default {-singleproc 1 -verbose {body pass skip start error line usec}} -help\ "Pairs of flags/values that will be passed to tcltest::configure before running the tests. - The supplied flags will be merged with the default flags." + The supplied flags will be merged with the default flags. + + -singleproc is interpreted by this runner rather than by tcltest's runAllTests: + 1 (default) sources each test file in a fresh child interp of this process. + 0 runs each test file in a child process of the same executable via + testsupport/child_test_runner.tcl, with the same module paths and tcltest + options forwarded through a generated environment payload. A nonzero child + exit is reported as a file-level failure with the stderr tail surfaced. + Prefer a native tclsh for -singleproc 0: children of a kit executable boot + with kit-stamped punk packages preloaded, which can shadow the src dev + modules under test." -show-raw-output -type boolean -default 0 -help\ "If true, the raw stdout and stderr produced by tcltest from the test files will be shown in addition to the parsed results. This will be in markdown code blocks under headings: @@ -457,17 +552,7 @@ dict set tcltestoptions -file $file_globs #Cleaned up (file delete -force) before exit; an aborted run leaves it in the OS temp area rather than the source tree. set runtests_tmpdir "" if {![dict exists $opt_tcltestoptions -tmpdir]} { - if {[catch {file tempdir} runtests_tmpdir]} { - #'file tempdir' requires tcl 8.7+ - fall back to env temp + pid subdir for 8.6 - set runtests_tmpdir "" - foreach evar {TMPDIR TEMP TMP} { - if {[info exists ::env($evar)] && [file isdirectory $::env($evar)]} { - set runtests_tmpdir [file join $::env($evar) runtests_tmp_[pid]] - file mkdir $runtests_tmpdir - break - } - } - } + set runtests_tmpdir [runtests_create_tempdir runtests_tmp] if {$runtests_tmpdir ne ""} { dict set tcltestoptions -tmpdir $runtests_tmpdir } @@ -520,6 +605,37 @@ if {!$report_json_only} { puts "test tmlist: $test_tmlist" puts "tcltestoptions: $tcltestoptions" } + +#multi-process mode setup: each test file runs as +# testsupport/child_test_runner.tcl +#with stdout/stderr captured to files under a run-scoped work directory. The generated payload +#forwards the parent-computed environment (module paths, auto_path, modpod ifneeded definitions, +#tcltest options) so children select the same unbuilt dev modules as the singleproc testinterp. +set runtests_workdir "" +if {!$singleproc} { + if {[llength $kit_lib_bases]} { + puts stderr "WARNING: -singleproc 0 under a kit executable: child processes boot via the kit's script dispatch with kit-stamped punk packages already loaded, which can shadow the src dev modules under test. Prefer a native tclsh for multi-process runs." + } + set child_bootstrap [file join $test_base testsupport child_test_runner.tcl] + if {![file exists $child_bootstrap]} { + puts stderr "Error: missing child bootstrap script: $child_bootstrap" + exit 2 + } + set runtests_workdir [runtests_create_tempdir runtests_work] + if {$runtests_workdir eq ""} { + puts stderr "Error: could not create a work directory for multi-process test runs (no usable temp area)" + exit 2 + } + set child_payloadfile [file join $runtests_workdir child_payload.tcl] + set child_outfile [file join $runtests_workdir child_stdout.txt] + set child_errfile [file join $runtests_workdir child_stderr.txt] + #each child runs one file in one process, so its tcltest env mirrors the singleproc + #testinterp (-singleproc 1; per-file -testdir is computed child-side from the test file path) + set child_tcltestoptions $tcltestoptions + dict set child_tcltestoptions -singleproc 1 + runtests_write_child_payload $child_payloadfile $test_tmlist $test_auto_path $ifneeded_script $child_tcltestoptions +} + foreach testfile_relative $testfiles { set testfile [file normalize [file join $test_base $testfile_relative]] if {$report_detailed_markdown} { @@ -562,21 +678,9 @@ foreach testfile_relative $testfiles { } flush stdout } else { - #todo - we need to set up the environment for the test file - such as the module search path to ensure it picks up the unbuilt modules under development rather than any installed versions. - #we also need to pass the tcltestoptions to the test file. - #one way would be to prepend this data to the testfiledata in a temporary file and then run that temporary file. - #Another way might be to pipe the whole script through stdin to the child process - but that may cause issues with tcltest's use of stdin for user input. - if {[catch { - puts stderr "calling 'runout $thisexecutable $testfile'"; flush stderr - set result [shellrun::runx $thisexecutable $testfile] - #set result [shellrun::runx ls] - } errM]} { - puts stderr "error calling 'runout $thisexecutable $testfile' $errM"; flush stderr - set result {none ""} - } + set result [runtests_run_child_process $thisexecutable $child_bootstrap $child_payloadfile $testfile $child_outfile $child_errfile] if {$report_detailed_markdown} { - puts stdout "executed $thisexecutable $testfile " - puts stdout "result keys: [dict keys $result] " + puts stdout "executed $thisexecutable testsupport/child_test_runner.tcl $testfile_relative " } flush stdout } @@ -616,7 +720,29 @@ foreach testfile_relative $testfiles { set resultdict [punk::tcltestrun::parse_testrun $result $testfile] set file_status pass set file_warnings [list] - if {[dict get $resultdict summaryline_detected] == 0} { + set child_exit_failures [list] + set child_exitcode [runtests_dict_get_default $resultdict exitcode ""] + if {$child_exitcode ni [list "" 0]} { + #multi-process mode: a nonzero child exit is a file-level failure regardless of any + #summary line - the child usually died before reaching tcltest::cleanupTests. + #(previously this was misreported as a missing-cleanupTests warning with the child's + #stderr discarded) + set stderr_tail [runtests_text_tail [runtests_dict_get_default $result stderr ""] 2000] + set child_exit_failures [list [dict create name $testfile_relative status ERROR errorcode [list CHILDPROCESS exit $child_exitcode] errorinfo $stderr_tail]] + puts stderr "ERROR: test file child process exited with code $child_exitcode: $testfile" + if {!$report_json_only} { + puts stdout "test file $testfile_relative child process failed (exitcode $child_exitcode)" + } + dict lappend tallydict files_with_fails $testfile_relative + set file_status error + if {[dict get $resultdict summaryline_detected] == 1} { + #the child still reported results before dying - keep them in the tallies + dict incr tallydict total [dict get $resultdict summaryline_total] + dict incr tallydict passed [dict get $resultdict summaryline_passed] + dict incr tallydict skipped [dict get $resultdict summaryline_skipped] + dict incr tallydict failed [dict get $resultdict summaryline_failed] + } + } elseif {[dict get $resultdict summaryline_detected] == 0} { set warning_message "No tcltest summary line detected; test file may be missing tcltest::cleanupTests" set file_warnings [list [runtests_warning_summary missing-cleanupTests $warning_message 0]] puts stderr "WARNING: $warning_message: $testfile" @@ -648,7 +774,7 @@ foreach testfile_relative $testfiles { } } - set failures [runtests_failure_summaries $resultdict] + set failures [concat [runtests_failure_summaries $resultdict] $child_exit_failures] set skips [runtests_skip_summaries $resultdict] set passes [runtests_pass_summaries $testfile_relative $resultdict] if {$file_status ne "warning"} { @@ -682,6 +808,16 @@ foreach testfile_relative $testfiles { runtests_print_file_warning $testfile_relative $warning $observed_passes $observed_skips $observed_failures } } + if {[llength $child_exit_failures]} { + puts stdout "### child process failure for $testfile_relative" + puts stdout "" + puts stdout "- exitcode: $child_exitcode " + puts stdout " stderr tail: " + puts stdout " ```" + puts stdout " [dict get [lindex $child_exit_failures 0] errorinfo]" + puts stdout " ```" + puts stdout "" + } if {$opt_show_passes && $file_status ne "warning"} { puts stdout "" puts stdout "### testcase passes for $testfile_relative" @@ -863,6 +999,9 @@ if {!$report_json_only} { if {$runtests_tmpdir ne "" && [file isdirectory $runtests_tmpdir]} { catch {file delete -force $runtests_tmpdir} } +if {$runtests_workdir ne "" && [file isdirectory $runtests_workdir]} { + catch {file delete -force $runtests_workdir} +} if {$opt_strict_exit} { if {[dict get $tallydict failed] > 0 || [llength [dict get $tallydict files_with_fails]] > 0} { diff --git a/src/tests/testsupport/child_test_runner.tcl b/src/tests/testsupport/child_test_runner.tcl new file mode 100644 index 00000000..b140750f --- /dev/null +++ b/src/tests/testsupport/child_test_runner.tcl @@ -0,0 +1,82 @@ +#child_test_runner.tcl - child-process bootstrap for src/tests/runtests.tcl multi-process mode +#(-tcltestoptions {-singleproc 0}). +#Invoked as: child_test_runner.tcl ?? +#The payload file is generated per run by runtests.tcl and applies the parent-computed test +#environment in the singleproc-testinterp order: package prefer latest, tcl::tm test paths, +#auto_path, modpod 'package ifneeded' definitions, and the base tcltest options in +#::runtests_child_tcltestoptions. +#The optional childtmpdir argument overrides tcltest -tmpdir per child (parallel scheduling); +#empty/absent means the shared -tmpdir carried in the payload options is used. +#Exit codes: 0 = test file ran to completion (tcltest failures are reported via the tcltest +#output stream, not the exit code - matching tcltest single-file semantics); nonzero = the test +#file (or this bootstrap) died, which runtests.tcl classifies as a file-level failure with the +#stderr tail surfaced; 98 = bootstrap usage/environment error. +#Not a test suite: runtests.tcl discovery excludes *.tcl under src/tests. + +#Initialize process-level clock/timezone state while the DEFAULT module paths are still in place. +#The first script-level 'clock format' pulls in msgcat (and tzdata) from the runtime's own module +#paths; the payload wipes those paths and nothing under the test module paths supplies msgcat. +#The singleproc testinterp is shielded from this only because the runtests parent process uses +#'clock format' under default paths before running test files (process-wide C-level caches) - a +#fresh child process must warm up explicitly or e.g zipper.test fails with +#"can't find package msgcat" out of clock format. +clock format [clock seconds] + +lassign $argv payloadfile testfile childtmpdir +if {$payloadfile eq "" || ![file exists $payloadfile]} { + puts stderr "child_test_runner.tcl: payload file not found: '$payloadfile'" + exit 98 +} +if {$testfile eq ""} { + puts stderr "child_test_runner.tcl: no test file supplied" + exit 98 +} +set testfile [file normalize $testfile] +if {![file exists $testfile]} { + puts stderr "child_test_runner.tcl: test file not found: '$testfile'" + exit 98 +} + +source $payloadfile + +if {![info exists ::runtests_child_tcltestoptions]} { + puts stderr "child_test_runner.tcl: payload did not define ::runtests_child_tcltestoptions" + exit 98 +} +set tcltestoptions $::runtests_child_tcltestoptions +#-testdir is per test file (mirrors the per-file -testdir the runtests loop sets in singleproc mode) +dict set tcltestoptions -testdir [file dirname $testfile] +if {$childtmpdir ne ""} { + dict set tcltestoptions -tmpdir $childtmpdir +} + +#mirror the singleproc testinterp setup: ::argv holds the tcltest options and tcltest is not +#package required until ::argv is in place (see the note at the bottom of runtests.tcl - +#tcltest examines ::argv itself). The explicit tcltest::configure call below also disarms +#tcltest's argv auto-processing traces, so the options cannot be double-applied. +set ::argv0 $testfile +set ::argv $tcltestoptions +set ::argc [llength $tcltestoptions] +package require tcltest +tcltest::configure {*}$tcltestoptions + +#mirror the singleproc testinterp preload: runtests.tcl package requires shellrun into the +#testinterp after tcltest configure, and several existing suites use punk::* commands without +#an explicit package require of their own - they depend on this preload supplying them +#(e.g punk::ansi::ansistrip in the modules/punk/ansi suites; 17 files / 97 tests error without +#it, verified 2026-07-18 with scriptlib/developer/runtests_parity.tcl). Keeping the child +#identical to the testinterp preserves result parity. Making suite dependencies explicit and +#dropping this preload for leaner/faster children is a candidate future cleanup - the parity +#tool is the check for it. +package require shellrun +#The testinterp sources each test file via 'shellrun::runx -tcl source ', and executing +#runx pulls in further runtime dependencies that plain 'package require shellrun' does not +#(currently punk::lib - without it 7 files / 31 tests error: the punk::lib suites plus +#punk::ansi::grepstr/untabify and punk::args examples rendering, which call punk::lib +#internally). Exercise one no-op runx -tcl call so the child acquires exactly whatever the +#testinterp's runx-driven load acquires, now and under future shellrun changes. +shellrun::runx -tcl set ::runtests_child_warmed 1 + +source $testfile +#natural end-of-script exit: code 0. An uncaught error from the test file propagates, prints +#errorInfo to stderr and exits nonzero - runtests.tcl reports that as a file-level failure.