Browse Source
A terminal query (internal::get_ansi_response_payload and every query proc
layered above it - get_cursor_pos, dec_get_mode, ...) on the process-default
console {stdin stdout} issued by a thread that is not the registered owner is
now forwarded whole to the owning thread via synchronous thread::send, so the
query queueing, raw-mode cycling, cooperative reader handling
(input_chunks_waiting) and settled can_respond gating all execute in the
owner's context. Owner-side errors propagate to the caller with routing
context. Routing happens before the local can_respond gate deliberately: a
non-owner context's anchored view of the default console may be unsettled
while the owner's is settled.
New internal::console_route_owner makes the decision: routing applies to the
default console pair only - non-std channel names are thread-local, so an
{in out} pair spec always names the calling thread's own console and operates
locally (a console constructed and owned by code-interp/worker code
round-trips nowhere). Unregistered, owner==caller and dead-owner
(liveness-validated) cases also operate locally, preserving single-interp
behaviour exactly.
The synchronous send relies on the owner servicing events while the caller
blocks - the property the repl-installed vt52/colour/mode aliases already
depend on. Those aliases are unaffected: a call arriving in the owner
resolves to owner==self and takes the local path, so no double-hop and no
ping-pong.
Tests: new ownerrouting.test covers the routing decision (unregistered/self/
other-live-thread/non-default-pair/dead-owner) and the transport (recorder in
a worker-thread owner: args marshalled intact, execution in the owner thread,
query procs above the choke point inherit the routing, owner-side error
propagation). Full suite passes (baseline exec-14.3 only).
G-007 remains active: the remaining acceptance verification is interactive -
a terminal query from a live punk session's code interp against the default
console (cooperating with the repl reader), which needs a real responding
terminal.
Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
4 changed files with 181 additions and 1 deletions
@ -0,0 +1,125 @@
|
||||
package require tcltest |
||||
tcltest::configure {*}$::argv |
||||
|
||||
#min-version bounds document that these tests target the dev modules' API and protect against |
||||
#stable copies shadowing them if this file is sourced outside runtests.tcl (whose testinterp |
||||
#runs 'package prefer latest'). |
||||
package require punk::console 999999.0a1.0- |
||||
|
||||
#Tests for G-007 choke-point brokering: a terminal query (internal::get_ansi_response_payload |
||||
#and every query proc layered above it) on the process-default console {stdin stdout} routes |
||||
#to the console-owning thread when the caller is not the owner; an unregistered console, an |
||||
#owner==caller console, and any non-default {in out} pair operate locally (non-std channel |
||||
#names are thread-local, so a pair spec always names the calling thread's own console). |
||||
#The routing decision is internal::console_route_owner; the transport is a synchronous |
||||
#thread::send into the owning thread's main interp (the established vt52-alias property: |
||||
#the owner services events while the caller blocks). |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
variable common { |
||||
set result "" |
||||
} |
||||
|
||||
test routing_decision {console_route_owner: local for unregistered/self-owned/non-default/dead-owner; owner tid only for the default console owned by another live thread}\ |
||||
-setup [string cat $common { |
||||
set workertid [thread::create {thread::wait}] |
||||
}]\ |
||||
-body { |
||||
#unregistered default console - operate locally |
||||
lappend result [punk::console::internal::console_route_owner {stdin stdout}] |
||||
#caller is the owner - local fast path |
||||
punk::console::console_owner_register {stdin stdout} |
||||
lappend result [punk::console::internal::console_route_owner {stdin stdout}] |
||||
punk::console::console_owner_forget {stdin stdout} |
||||
#another live thread owns the default console - route to it |
||||
punk::console::console_owner_register {stdin stdout} $workertid |
||||
lappend result [expr {[punk::console::internal::console_route_owner {stdin stdout}] eq $workertid}] |
||||
#non-default pair never routes, even with a registry entry (the entry qualifies |
||||
#the shared fact store; the pair names the calling thread's own channels) |
||||
punk::console::console_owner_register {chanx chany} $workertid |
||||
lappend result [punk::console::internal::console_route_owner {chanx chany}] |
||||
punk::console::console_owner_forget {chanx chany} |
||||
#dead owner - consult-time liveness validation clears the entry, operate locally |
||||
thread::release $workertid |
||||
set deadline [expr {[clock milliseconds] + 2000}] |
||||
while {[thread::exists $workertid] && [clock milliseconds] < $deadline} { |
||||
after 10 |
||||
} |
||||
lappend result [punk::console::internal::console_route_owner {stdin stdout}] |
||||
}\ |
||||
-cleanup { |
||||
catch {punk::console::console_owner_forget {stdin stdout}} |
||||
catch {punk::console::console_owner_forget {chanx chany}} |
||||
catch {thread::release $workertid} |
||||
}\ |
||||
-result [list\ |
||||
{}\ |
||||
{}\ |
||||
1\ |
||||
{}\ |
||||
{}\ |
||||
] |
||||
|
||||
test routing_query_forwarded_to_owner {a query on the owned default console executes in the owning thread with opts/values intact; query procs above the choke point inherit the routing; owner-side errors propagate with routing context}\ |
||||
-setup [string cat $common { |
||||
set workertid [thread::create {thread::wait}] |
||||
#the worker loads punk::console from the same module paths as the testinterp |
||||
thread::send $workertid [list set ::tmpaths [tcl::tm::list]] |
||||
thread::send $workertid [list set ::auto_path $::auto_path] |
||||
thread::send $workertid { |
||||
foreach p $::tmpaths {tcl::tm::path add $p} |
||||
package prefer latest |
||||
package require punk::console 999999.0a1.0- |
||||
#replace the real query primitive with a recorder: no real terminal is |
||||
#available under runtests, and the transport - not the terminal I/O - is |
||||
#what this test exercises |
||||
rename ::punk::console::internal::get_ansi_response_payload ::punk::console::internal::get_ansi_response_payload.real |
||||
set ::routingtest_mode ok |
||||
proc ::punk::console::internal::get_ansi_response_payload {args} { |
||||
set ::routingtest_seen [list [thread::id] $args] |
||||
if {$::routingtest_mode eq "error"} { |
||||
error "recorder-failure" |
||||
} |
||||
return "5;7" |
||||
} |
||||
} |
||||
punk::console::console_owner_register {stdin stdout} $workertid |
||||
}]\ |
||||
-body { |
||||
#direct call on the choke point routes and returns the owner-side result |
||||
set payload [punk::console::internal::get_ansi_response_payload -console {stdin stdout} -expected_ms 123 "\x1b\[6n" {(.*)(\x1b\[([0-9]+;[0-9]+)R)$}] |
||||
lappend result $payload |
||||
lassign [thread::send $workertid {set ::routingtest_seen}] seentid seenargs |
||||
#the call executed in the owning thread |
||||
lappend result [expr {$seentid eq $workertid}] |
||||
#opts and values arrived intact (values are the trailing pair; opts precede them) |
||||
lappend result [lrange $seenargs end-1 end] |
||||
set seenopts [lrange $seenargs 0 end-2] |
||||
lappend result [dict get $seenopts -console] |
||||
lappend result [dict get $seenopts -expected_ms] |
||||
#a query proc layered above the choke point inherits the routing (get_cursor_pos |
||||
#returns the payload unchanged) |
||||
lappend result [punk::console::get_cursor_pos] |
||||
#an error raised in the owning thread propagates to the caller with routing context |
||||
thread::send $workertid {set ::routingtest_mode error} |
||||
lappend result [expr {[catch {punk::console::internal::get_ansi_response_payload -console {stdin stdout} "\x1b\[6n" {(.*)(\x1b\[([0-9]+;[0-9]+)R)$}} errM] |
||||
&& [string match "*routed to console-owning thread*recorder-failure*" $errM]}] |
||||
}\ |
||||
-cleanup { |
||||
catch {punk::console::console_owner_forget {stdin stdout}} |
||||
catch {thread::release $workertid} |
||||
}\ |
||||
-result [list\ |
||||
{5;7}\ |
||||
1\ |
||||
[list "\x1b\[6n" {(.*)(\x1b\[([0-9]+;[0-9]+)R)$}]\ |
||||
{stdin stdout}\ |
||||
123\ |
||||
{5;7}\ |
||||
1\ |
||||
] |
||||
|
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary. |
||||
Loading…
Reference in new issue