diff --git a/src/tests/AGENTS.md b/src/tests/AGENTS.md index 3fec4ac8..454ac79e 100644 --- a/src/tests/AGENTS.md +++ b/src/tests/AGENTS.md @@ -36,7 +36,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 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). `testsupport/httpfixture.tcl` (G-119) is a minimal http GET file server exec'd as a child process when a test needs a REAL local http endpoint (curl and Windows PowerShell Invoke-WebRequest have no shared file:// support): binds an ephemeral 127.0.0.1 port, prints `PORT ` on stdout, serves a docroot (octet-stream, connection-close), and exits on stdin EOF (the parent test holds the pipe) or a 600s safety timeout - used by `shell/testsuites/binscripts/runtimecmd_freshness.test` as the fixture punkbin server behind the `PUNKBIN_URL` override. +- `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). `testsupport/json_emit.tcl` is the JSON emitter for the `-report json` output (`runtests_json_string`, `runtests_json_string_array`, `runtests_json_testdict_array`, `runtests_json_int?`), sourced by `runtests.tcl` so the `runner/testsuites/parser/jsonemit.test` unit suite can exercise it without spawning a child run. Hand-rolled (not tcllib `json::write`) to keep the runner's bootstrap dependency surface minimal; the `jsonemit.test` suite pins the defect class it guards (RFC 8259 number syntax - rejects `007`/`+5`/`0x10`/`0o17`/`0b101` that `string is entier -strict` accepted as bare; C0 control-char escaping of the whole 0x00-0x1F range not just `\n \r \t`; and `entier` deprecation per TIP 514 - the predicate is a version-independent regex, no `string is entier`). `testsupport/httpfixture.tcl` (G-119) is a minimal http GET file server exec'd as a child process when a test needs a REAL local http endpoint (curl and Windows PowerShell Invoke-WebRequest have no shared file:// support): binds an ephemeral 127.0.0.1 port, prints `PORT ` on stdout, serves a docroot (octet-stream, connection-close), and exits on stdin EOF (the parent test holds the pipe) or a 600s safety timeout - used by `shell/testsuites/binscripts/runtimecmd_freshness.test` as the fixture punkbin server behind the `PUNKBIN_URL` override. - 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/runner/AGENTS.md b/src/tests/runner/AGENTS.md index d36a20bc..9e7c401e 100644 --- a/src/tests/runner/AGENTS.md +++ b/src/tests/runner/AGENTS.md @@ -12,7 +12,7 @@ Test suites for the `src/tests/runtests.tcl` harness itself (discovery/path-targ - Suites here may exec `runtests.tcl -discover-only 1` child processes of `[info nameofexecutable]` (subsecond since the G-093 two-stage boot — discovery loads only punk::args + punk::path before the early exit). Keep such children cheap and few: a suite file's child-process cost lands in its `-jobs` child wall. - `testsuites/discovery/pathdiscovery.test` is the G-093 runner-targeting regression suite: it pins the directory-oriented `-include-paths`/`-exclude-paths` semantics (the separable `X` / `X/*` / `X/**` / `X/***` lattice, passed through to punk::path::treefilenames) at three levels — the `runtests_discovery::dir_matches_any` classifier (also used by `-serial-paths` and the zero-match advisory), composed `discover_testfiles` over a fixture tree, and end-to-end `-discover-only` runs against the real test tree, including the G-092 measurement set in its corrected `X/***` spelling and the `X/**` zero-match advisory case. -- `testsuites/parser/` is the G-161 punk::tcltestrun `parse_testrun` characterization pair. `parsetestrun.test` drives synthetic captured-output streams (mirroring real tcltest emission) straight into `parse_testrun`: multi-line opening-banner fidelity with summary flow, single-line regression shape, multi-line ERROR-status capture, anchored false-open abandonment, glob-metacharacter/backslash test-name closing-banner exact match (0.4.2), and the pinned historic behaviours (emulated single-line banner confounder cost; no-start-events fallback). `multilinebanner.test` is end-to-end: one child runtests.tcl run per mode (single-process and `-singleproc 0`) over `fixtures/multilinedesc.testfixture`, asserting the json report's failure entry (FAILED + result_was/result_expected) and trusted summary as exact-text probes of the fixed-order json emitter. The fixture's non-`.test` extension keeps it invisible to every default `*.test` discovery — child runs target it explicitly by file-tail glob; keep deliberately-failing fixtures on non-`.test` extensions. `multilinebanner.test` spawns exactly two full run-phase children (the dominant `-jobs` child wall of this directory); keep it at two. +- `testsuites/parser/` is the G-161 punk::tcltestrun `parse_testrun` characterization pair, plus `jsonemit.test` - the unit suite for the `testsupport/json_emit.tcl` JSON emitter (RFC 8259 number syntax, C0 control-char escaping, `entier` deprecation per TIP 514, named-escape byte regression, tcllib-json round-trip). `parsetestrun.test` drives synthetic captured-output streams (mirroring real tcltest emission) straight into `parse_testrun`: multi-line opening-banner fidelity with summary flow, single-line regression shape, multi-line ERROR-status capture, anchored false-open abandonment, glob-metacharacter/backslash test-name closing-banner exact match (0.4.2), and the pinned historic behaviours (emulated single-line banner confounder cost; no-start-events fallback). `multilinebanner.test` is end-to-end: one child runtests.tcl run per mode (single-process and `-singleproc 0`) over `fixtures/multilinedesc.testfixture`, asserting the json report's failure entry (FAILED + result_was/result_expected) and trusted summary as exact-text probes of the fixed-order json emitter. The fixture's non-`.test` extension keeps it invisible to every default `*.test` discovery — child runs target it explicitly by file-tail glob; keep deliberately-failing fixtures on non-`.test` extensions. `multilinebanner.test` spawns exactly two full run-phase children (the dominant `-jobs` child wall of this directory); keep it at two. - Fixture trees go under tcltest's `temporaryDirectory` (the runner's run-scoped `-tmpdir`), never into the source tree. - Suites here must stay parallel-safe (no console interaction) — they are not in `-serial-paths`. diff --git a/src/tests/runner/testsuites/parser/jsonemit.test b/src/tests/runner/testsuites/parser/jsonemit.test new file mode 100644 index 00000000..b91ea3db --- /dev/null +++ b/src/tests/runner/testsuites/parser/jsonemit.test @@ -0,0 +1,134 @@ +# -*- tcl -*- +# Unit suite for the runtests.tcl JSON emitter (testsupport/json_emit.tcl). +# Sources the emitter directly so the tests are fast (no child runtests run), +# and pins the defect class the hardening closed: +# - RFC 8259 number syntax: Tcl-integer-class forms that are NOT valid JSON +# numbers (leading zeros 007, a leading +, hex/octal/binary 0x/0o/0b) must +# take the quoted-string path, not be emitted bare. +# - C0 control-char escaping: RFC 8259 forbids raw 0x00-0x1F in strings; the +# emitter must escape the whole range (not just \n \r \t). +# - entier deprecation hygiene (TIP 514): the predicate must not use +# 'string is entier', which is deprecated in Tcl 9.0. +# - regression of the named escapes: \n \r \t backslash quote must still +# produce the exact bytes the multilinebanner.test end-to-end suite probes. +# - round-trip: a representative testdict array re-parses via tcllib json. +# +# Run: tclsh src/tests/runtests.tcl -report compact -show-passes 0 -include-paths runner/testsuites/parser jsonemit.test + +package require tcltest +#tcllib json decoder for the round-trip test (skipped if unavailable - the +#native-tclsh runner may not have tcllib on the auto_path; the kit runner does). +tcltest::testConstraint jsonAvailable [expr {![catch {package require json}]}] + +namespace eval ::testspace { + namespace import ::tcltest::* + + variable testbase [file dirname [file dirname [file dirname [file dirname [file normalize [info script]]]]]] + #load the emitter under test (procs only, no side effects). + source [file join $testbase testsupport json_emit.tcl] + + #added 2026-08-07 (agent - runtests json emitter hardening: RFC8259 number syntax, C0 control-char escaping, entier deprecation per TIP 514) + test jsonemit-number-1.0 {Tcl-integer forms that are not valid JSON numbers are emitted as quoted strings} -body { + set result [list] + foreach v {007 +5 0x10 0o17 0b101 1e3 1.5} { + lappend result [runtests_json_int? $v] + set emit [runtests_json_testdict_array [list [list k $v]]] + set needle "\"k\":\"$v\"" + lappend result [expr {[string first $needle $emit] >= 0}] + } + set result + } -result {0 1 0 1 0 1 0 1 0 1 0 1 0 1} + + #added 2026-08-07 (agent - runtests json emitter hardening) + test jsonemit-number-1.1 {valid JSON integers are emitted bare} -body { + set result [list] + foreach v {0 -0 -5 42 999999999999999999999999999999} { + lappend result [runtests_json_int? $v] + set emit [runtests_json_testdict_array [list [list k $v]]] + set needle "\"k\":$v" + lappend result [expr {[string first $needle $emit] >= 0}] + } + set result + } -result {1 1 1 1 1 1 1 1 1 1} + + #added 2026-08-07 (agent - runtests json emitter hardening) + test jsonemit-number-1.2 {whitespace-padded integers take the quoted path (G-093 regression)} -body { + set result [list] + lappend result [runtests_json_int? " 5"] + lappend result [runtests_json_int? "5 "] + lappend result [runtests_json_int? " 0 "] + set result + } -result {0 0 0} + + #added 2026-08-07 (agent - runtests json emitter hardening) + test jsonemit-ctrl-1.0 {no raw C0 control char survives in a string} -body { + #build a string with one of every C0 control 0x00-0x1F + set s "" + for {set cp 0} {$cp < 32} {incr cp} { + append s [format %c $cp] + } + set enc [runtests_json_string $s] + set bad 0 + foreach ch [split $enc ""] { + set icp [scan $ch %c] + if {$icp < 32} { incr bad } + } + set bad + } -result 0 + + #added 2026-08-07 (agent - runtests json emitter hardening) + test jsonemit-ctrl-1.1 {backspace and formfeed use short escapes, others use u00XX} -body { + set result [list] + lappend result [expr {[string first "\\b" [runtests_json_string [format %c 8]]] >= 0}] + lappend result [expr {[string first "\\f" [runtests_json_string [format %c 12]]] >= 0}] + lappend result [expr {[string first "\\u0007" [runtests_json_string [format %c 7]]] >= 0}] + lappend result [expr {[string first "\\u0000" [runtests_json_string [format %c 0]]] >= 0}] + lappend result [expr {[string first "\\u001f" [runtests_json_string [format %c 31]]] >= 0}] + set result + } -result {1 1 1 1 1} + + #added 2026-08-07 (agent - runtests json emitter hardening) + test jsonemit-escapes-1.0 {named escapes produce exact bytes probed by multilinebanner.test} -body { + set result [list] + lappend result [string equal [runtests_json_string "x\n"] "\"x\\n\""] + lappend result [string equal [runtests_json_string "y\r"] "\"y\\r\""] + lappend result [string equal [runtests_json_string "z\t"] "\"z\\t\""] + lappend result [string equal [runtests_json_string "\\"] "\"\\\\\""] + lappend result [string equal [runtests_json_string "\""] "\"\\\"\""] + set result + } -result {1 1 1 1 1} + + #added 2026-08-07 (agent - runtests json emitter hardening - TIP 514) + test jsonemit-deprec-1.0 {the number predicate uses no deprecated string-is-entier} -body { + set result [list] + set body [info body runtests_json_int?] + lappend result [expr {[string first "regexp" $body] >= 0}] + lappend result [expr {[string first "entier" $body] < 0}] + set abody [info body runtests_json_testdict_array] + lappend result [expr {[string first "runtests_json_int?" $abody] >= 0}] + lappend result [expr {[string first "string is entier" $abody] < 0}] + set result + } -result {1 1 1 1} + + #added 2026-08-07 (agent - runtests json emitter hardening) + test jsonemit-roundtrip-1.0 {a representative testdict array re-parses via tcllib json} -constraints jsonAvailable -body { + set td [list \ + [dict create name "t1" status "FAILED" result_was "007" microseconds 12345] \ + [dict create name "t2" status "PASS" microseconds 999999999999999999999999999999] \ + ] + set j [runtests_json_testdict_array $td] + set d [json::json2dict $j] + set r0 [lindex $d 0] + set result [list] + lappend result [dict get $r0 name] + lappend result [dict get $r0 result_was] + lappend result [dict get $r0 microseconds] + set result + } -result {t1 007 12345} + + cleanupTests +} + +# Local Variables: +# mode: tcl +# End: \ No newline at end of file diff --git a/src/tests/runtests.tcl b/src/tests/runtests.tcl index 29ad2847..2fd7228f 100644 --- a/src/tests/runtests.tcl +++ b/src/tests/runtests.tcl @@ -62,38 +62,13 @@ if {[info commands ::lpop] eq ""} { #runner-targeting regression suite source [file join $test_base testsupport discovery.tcl] -proc runtests_json_string {text} { - set text [string map [list \\ \\\\ \" \\\" \n \\n \r \\r \t \\t] $text] - return "\"$text\"" -} - -proc runtests_json_string_array {values} { - set parts [list] - foreach value $values { - lappend parts [runtests_json_string $value] - } - return "\[[join $parts ,]\]" -} - -proc runtests_json_testdict_array {testdicts} { - set parts [list] - foreach testdict $testdicts { - set fields [list] - foreach {key value} $testdict { - if {[string is entier -strict $value] && $value eq [string trim $value]} { - #string is entier accepts surrounding whitespace even with -strict: a - #value like "0\n" must take the quoted-string path or the raw newline - #lands inside the json line (broke a report when a failed test's - #result_was carried a trailing newline - found 2026-07-20, G-093 work) - lappend fields "[runtests_json_string $key]:$value" - } else { - lappend fields "[runtests_json_string $key]:[runtests_json_string $value]" - } - } - lappend parts "{[join $fields ,]}" - } - return "\[[join $parts ,]\]" -} +#JSON emitter for the -report json output (runtests_json_string, +#runtests_json_string_array, runtests_json_testdict_array, runtests_json_int?). +#Sourced from testsupport so the runner jsonemit.test suite can unit-test it +#directly without spawning a child runtests run. See that file for the defect +#class it guards (RFC 8259 number syntax, C0 control-char escaping, entier +#deprecation per TIP 514). +source [file join $test_base testsupport json_emit.tcl] proc runtests_count_dict_entries {value} { if {[llength $value] == 0} { diff --git a/src/tests/testsupport/json_emit.tcl b/src/tests/testsupport/json_emit.tcl new file mode 100644 index 00000000..ce2fb0be --- /dev/null +++ b/src/tests/testsupport/json_emit.tcl @@ -0,0 +1,81 @@ +#testsupport/json_emit.tcl - JSON emitter for the runtests.tcl -report json output. +# +#Sourced by runtests.tcl and by the runner jsonemit.test unit suite. Defines +#procs only - no side effects, no package requires - so sourcing it for unit +#tests is free. Hand-rolled (not tcllib json::write) deliberately, to keep the +#runner's dependency surface minimal at the boot level where the json report is +#emitted; the jsonemit.test suite pins the defect class this guards against. +# +#Why hand-rolled instead of json::write: the runtests runner is the bootstrap +#path for the whole source-tree suite and is expected to run under bare native +#tclsh too (8.6 runner supported per src/tests/AGENTS.md), where tcllib may not +#be on the auto_path. The emitter is small and the regression suite keeps it +#honest. The punk::path -return json machine-returns work (G-NNN, proposed) +#uses tcllib json::write instead - that path always has tcllib available. + +#RFC 8259 integer grammar: optional minus, then "0" or a non-zero-led digit +#run. This rejects the Tcl-integer-class forms that are NOT valid JSON numbers +#(leading zeros like 007, a leading +, hex/octal/binary 0x/0o/0b prefixes) and +#any whitespace padding. It replaces the prior `string is entier -strict` +#predicate: entier is deprecated in Tcl 9.0 per TIP 514 (string is integer +#became the canonical unlimited-range form), and this regex is version- +#independent and syntax-correct, so it eliminates entier use entirely rather +#than gating it by Tcl version. The G-093 "0\n" whitespace-padded-entier bug +#(a failed test's result_was carried a trailing newline that string is entier +#-strict accepted, embedding a raw newline in the json line) is subsumed: the +#regex anchors with ^...$, so surrounding whitespace fails the match and the +#value takes the quoted-string path. +proc runtests_json_int? {value} { + regexp -- {^-?(0|[1-9][0-9]*)$} $value +} + +#Escape a string for JSON. RFC 8259 forbids raw control chars 0x00-0x1F in +#strings. The named escapes below (\\ \" \n \r \t) are preserved byte-for-byte: +#the multilinebanner.test end-to-end suite probes exact substrings such as +#"result_was":"x\n" where \n is the literal backslash-n byte pair the emitter +#produces. The second pass then handles the REST of the C0 control set that +#the first map left raw: 0x08 (backspace) and 0x0C (formfeed) use the short +#escapes \b \f; every other control char uses \u00XX. (G-093 patched only the +#whitespace-padded-entier path; this closes the rest of the C0 set - found +#2026-08-07.) +proc runtests_json_string {text} { + set text [string map [list \\ \\\\ \" \\\" \n \\n \r \\r \t \\t] $text] + set out "" + foreach ch [split $text ""] { + set cp [scan $ch %c] + if {$cp < 32} { + switch -- $cp { + 8 { append out "\\b" } + 12 { append out "\\f" } + default { append out [format "\\u%04x" $cp] } + } + } else { + append out $ch + } + } + return "\"$out\"" +} + +proc runtests_json_string_array {values} { + set parts [list] + foreach value $values { + lappend parts [runtests_json_string $value] + } + return "\[[join $parts ,]\]" +} + +proc runtests_json_testdict_array {testdicts} { + set parts [list] + foreach testdict $testdicts { + set fields [list] + foreach {key value} $testdict { + if {[runtests_json_int? $value]} { + lappend fields "[runtests_json_string $key]:$value" + } else { + lappend fields "[runtests_json_string $key]:[runtests_json_string $value]" + } + } + lappend parts "{[join $fields ,]}" + } + return "\[[join $parts ,]\]" +} \ No newline at end of file