Browse Source
0.2.0 (emit-side console targeting, migration plan phase 2):
- punk::console::ansi::* emit functions, mouse/paste toggles,
start_application_mode, vt52, set_tabstop_width, titleset, top-level
move, test_char_width and test_string_cursor accept an optional
trailing '-console <consolespec>' (channel pair, anchored
opunk::console instance name, or ::opunk::Console object value),
parsed by new internal::opt_console_out/opt_console_channels helpers
(+_var variants for triple-tail procs); documentation via shared
PUNKARGS fragment ::punk::console::argdoc::console_emit_opts
- fallback chains keep the console spec (get_tabstop_apparent_width ->
test_char_width; set_tabstop_width -> get_size)
- move_call_return now actually emits its cursor moves (previously
discarded the string-returning ansi::move results)
- get_size_using_cursorrestore uses string-returning
punk::ansi::cursor_on (was emitting to stdout mid-sequence)
0.3.0 (per-console facts, migration plan phase 3):
- is_vt52, tabwidth, cell_size, last_da1_result,
grapheme_cluster_support and check::has_bug_* keyed by canonical
{in out} pair via console_fact_get/console_fact_set; the default
console {stdin stdout} stores facts in the legacy namespace variables
so external readers (punk::repl, textblock, overtype, punk::ansi,
punk::ns) are unaffected
- vt52 state, size_via_query_mechanisms, get_cursor_pos and all
vt52-aware emit wrappers consult the spec'd console's is_vt52 fact
- grapheme_cluster_support and check::has_bug_* accept -console;
TERM_PROGRAM shortcut restricted to the default console
- check::has_bug_zwsp: cached-true path no longer errors; query
verdicts are now actually cached
- ansi_wanted/colour_disabled, ansi_available and raw-mode state
deliberately remain process-global (documented at the store)
PUNKARGS definitions follow the new Argument Order rule (@leaders for
leading positionals); internal helpers carry documentation-only
definitions. New suites: emitconsole.test (13) + consolefacts.test (9);
full console suite 49/49 on Tcl 9.0.3.
Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
5 changed files with 1594 additions and 227 deletions
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,272 @@
|
||||
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- |
||||
package require opunk::console 999999.0a1.0- |
||||
|
||||
#Tests for per-console facts (console_fact_get/console_fact_set): terminal-property facts |
||||
#(is_vt52, tabwidth, cell_size, last_da1_result, grapheme_cluster_support, has_bug_*) are keyed |
||||
#by canonical {in out} channel pair; the process-default console {stdin stdout} stores its facts |
||||
#in the legacy namespace variables so external readers (punk::repl, textblock, overtype, ...) |
||||
#keep working. |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
variable common { |
||||
set result "" |
||||
} |
||||
variable pipe_setup { |
||||
set result "" |
||||
lassign [chan pipe] rd wr |
||||
chan configure $wr -buffering none -translation lf |
||||
chan configure $rd -blocking 0 -translation lf |
||||
} |
||||
variable pipe_cleanup { |
||||
catch {chan close $wr} |
||||
catch {chan close $rd} |
||||
array unset ::punk::console::input_chunks_waiting $rd |
||||
} |
||||
#see emitconsole.test - windows [chan pipe] reads race the background reader thread |
||||
proc read_emitted {chan {timeout_ms 2000}} { |
||||
set data "" |
||||
set deadline [expr {[clock milliseconds] + $timeout_ms}] |
||||
while {[clock milliseconds] < $deadline} { |
||||
append data [read $chan] |
||||
if {$data ne ""} { |
||||
after 20 |
||||
append data [read $chan] |
||||
return $data |
||||
} |
||||
after 5 |
||||
} |
||||
return $data |
||||
} |
||||
|
||||
test facts_default_legacy_sync {default console facts read/write the legacy namespace variables}\ |
||||
-setup [string cat $common { |
||||
set saved_tabwidth $::punk::console::tabwidth |
||||
}]\ |
||||
-body { |
||||
lappend result [expr {[punk::console::console_fact_get {stdin stdout} tabwidth] eq $::punk::console::tabwidth}] |
||||
punk::console::console_fact_set {stdin stdout} tabwidth 11 |
||||
lappend result $::punk::console::tabwidth |
||||
lappend result [punk::console::console_fact_get {stdin stdout} is_vt52] |
||||
}\ |
||||
-cleanup { |
||||
set ::punk::console::tabwidth $saved_tabwidth |
||||
}\ |
||||
-result [list\ |
||||
1\ |
||||
11\ |
||||
0\ |
||||
] |
||||
|
||||
test facts_nondefault_isolated {non-default console facts don't touch legacy variables; unknown consoles get defaults}\ |
||||
-setup [string cat $common { |
||||
set saved_tabwidth $::punk::console::tabwidth |
||||
}]\ |
||||
-body { |
||||
punk::console::console_fact_set {chanx chany} tabwidth 4 |
||||
lappend result [punk::console::console_fact_get {chanx chany} tabwidth] |
||||
lappend result [expr {$::punk::console::tabwidth eq $saved_tabwidth}] |
||||
#unseen console pair falls back to the fact default |
||||
lappend result [punk::console::console_fact_get {chanp chanq} tabwidth] |
||||
lappend result [punk::console::console_fact_get {chanp chanq} has_bug_zwsp] |
||||
}\ |
||||
-cleanup { |
||||
set ::punk::console::tabwidth $saved_tabwidth |
||||
set ::punk::console::console_facts [dict create] |
||||
}\ |
||||
-result [list\ |
||||
4\ |
||||
1\ |
||||
8\ |
||||
-1\ |
||||
] |
||||
|
||||
test facts_spec_forms_resolve {instance-name and object-value specs resolve to the same fact entry as the channel pair}\ |
||||
-setup $pipe_setup -body { |
||||
opunk::console::create facttest1 $rd $wr |
||||
punk::console::console_fact_set facttest1 tabwidth 5 |
||||
lappend result [punk::console::console_fact_get [list $rd $wr] tabwidth] |
||||
set obj [opunk::console::instance facttest1] |
||||
lappend result [punk::console::console_fact_get $obj tabwidth] |
||||
}\ |
||||
-cleanup [string cat { |
||||
catch {opunk::console::forget facttest1} |
||||
set ::punk::console::console_facts [dict create] |
||||
} $pipe_cleanup]\ |
||||
-result [list\ |
||||
5\ |
||||
5\ |
||||
] |
||||
|
||||
test facts_vt52_per_console {vt52 mode set on a spec'd console doesn't affect the default console; emit wrappers honour it}\ |
||||
-setup [string cat $pipe_setup { |
||||
set saved_colour_disabled $::punk::console::colour_disabled |
||||
}]\ |
||||
-body { |
||||
set spec [list $rd $wr] |
||||
#query defaults to 0 |
||||
lappend result [punk::console::vt52 -console $spec] |
||||
#turn vt52 on for the pipe console - emits DECANM unset (DECRST 2) there |
||||
lappend result [punk::console::vt52 on -console $spec] |
||||
lappend result [expr {[read_emitted $rd] eq "\x1b\[?2l"}] |
||||
#default console's flag untouched |
||||
lappend result $::punk::console::is_vt52 |
||||
lappend result [punk::console::vt52] |
||||
#vt52-aware emit wrapper uses the per-console fact |
||||
punk::console::ansi::cursor_off -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::vt52cursor_off]}] |
||||
#string-returning ansi::move selects vt52 encoding for this console only |
||||
lappend result [expr {[punk::console::ansi::move 3 4 -console $spec] eq [punk::ansi::vt52move 3 4]}] |
||||
lappend result [expr {[punk::console::ansi::move 3 4] eq [punk::ansi::move 3 4]}] |
||||
#turn vt52 back off for the pipe console - emits ESC < |
||||
lappend result [punk::console::vt52 off -console $spec] |
||||
lappend result [expr {[read_emitted $rd] eq "\x1b<"}] |
||||
}\ |
||||
-cleanup [string cat { |
||||
#vt52 on/off toggles process-global colour state - restore |
||||
set ::punk::console::colour_disabled $saved_colour_disabled |
||||
set ::punk::console::console_facts [dict create] |
||||
} $pipe_cleanup]\ |
||||
-result [list\ |
||||
0\ |
||||
1\ |
||||
1\ |
||||
0\ |
||||
0\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
0\ |
||||
1\ |
||||
] |
||||
|
||||
test facts_tabwidth_per_console {set_tabstop_width records tabwidth for the spec'd console only}\ |
||||
-setup [string cat $pipe_setup { |
||||
set saved_tabwidth $::punk::console::tabwidth |
||||
set saved_hints [dict create] |
||||
foreach ev {TERM_PROGRAM MSYSTEM} { |
||||
if {[info exists ::env($ev)]} { |
||||
dict set saved_hints $ev [set ::env($ev)] |
||||
unset ::env($ev) |
||||
} |
||||
} |
||||
}]\ |
||||
-body { |
||||
punk::console::set_tabstop_width 4 -console [list $rd $wr] |
||||
lappend result [expr {[read_emitted $rd] ne ""}] |
||||
lappend result [punk::console::console_fact_get [list $rd $wr] tabwidth] |
||||
lappend result [expr {$::punk::console::tabwidth eq $saved_tabwidth}] |
||||
}\ |
||||
-cleanup [string cat { |
||||
dict for {ev val} $saved_hints { |
||||
set ::env($ev) $val |
||||
} |
||||
set ::punk::console::tabwidth $saved_tabwidth |
||||
set ::punk::console::console_facts [dict create] |
||||
} $pipe_cleanup]\ |
||||
-result [list\ |
||||
1\ |
||||
4\ |
||||
1\ |
||||
] |
||||
|
||||
test facts_cell_size_per_console {cell_size set/query is per-console; default legacy variable untouched}\ |
||||
-setup $pipe_setup -body { |
||||
set spec [list $rd $wr] |
||||
punk::console::cell_size -console $spec 12x24 |
||||
lappend result [punk::console::cell_size -console $spec] |
||||
lappend result [expr {$::punk::console::cell_size eq ""}] |
||||
}\ |
||||
-cleanup [string cat { |
||||
set ::punk::console::console_facts [dict create] |
||||
} $pipe_cleanup]\ |
||||
-result [list\ |
||||
12x24\ |
||||
1\ |
||||
] |
||||
|
||||
test facts_da1_per_console {get_device_attributes records last_da1_result for the queried console only}\ |
||||
-setup [string cat $common { |
||||
lassign [chan pipe] rdi wri |
||||
lassign [chan pipe] rdo wro |
||||
chan configure $wri -buffering none -translation lf |
||||
chan configure $wro -buffering none -translation lf |
||||
chan configure $rdo -blocking 0 -translation lf |
||||
set saved_da1 $::punk::console::last_da1_result |
||||
}]\ |
||||
-body { |
||||
after 40 [list apply [list {wchan} { |
||||
puts -nonewline $wchan "\x1b\[?1;2c" |
||||
flush $wchan |
||||
}] $wri] |
||||
set payload [punk::console::get_device_attributes [list $rdi $wro]] |
||||
lappend result $payload |
||||
lappend result [punk::console::console_fact_get [list $rdi $wro] last_da1_result] |
||||
lappend result [expr {$::punk::console::last_da1_result eq $saved_da1}] |
||||
}\ |
||||
-cleanup { |
||||
foreach c [list $wri $rdi $wro $rdo] { |
||||
catch {chan close $c} |
||||
} |
||||
array unset ::punk::console::input_chunks_waiting $rdi |
||||
set ::punk::console::console_facts [dict create] |
||||
}\ |
||||
-result [list\ |
||||
{1;2}\ |
||||
{1;2}\ |
||||
1\ |
||||
] |
||||
|
||||
test facts_has_bug_cached_paths {check::has_bug_* honour per-console recorded verdicts without re-testing (and without the old undefined-var error)}\ |
||||
-setup [string cat $common { |
||||
set saved_zwsp $::punk::console::check::has_bug_zwsp |
||||
}]\ |
||||
-body { |
||||
set spec {chanx chany} |
||||
#recorded true verdict - previously the cached-true path errored on an undefined variable |
||||
punk::console::console_fact_set $spec has_bug_zwsp 1 |
||||
lappend result [punk::console::check::has_bug_zwsp -console $spec] |
||||
punk::console::console_fact_set $spec has_bug_zwsp 0 |
||||
lappend result [punk::console::check::has_bug_zwsp -console $spec] |
||||
punk::console::console_fact_set $spec has_bug_legacysymbolwidth 1 |
||||
lappend result [punk::console::check::has_bug_legacysymbolwidth -console $spec] |
||||
#default console legacy variable is the storage for no-arg calls |
||||
set ::punk::console::check::has_bug_zwsp 0 |
||||
lappend result [punk::console::check::has_bug_zwsp] |
||||
}\ |
||||
-cleanup { |
||||
set ::punk::console::check::has_bug_zwsp $saved_zwsp |
||||
set ::punk::console::console_facts [dict create] |
||||
}\ |
||||
-result [list\ |
||||
1\ |
||||
0\ |
||||
1\ |
||||
0\ |
||||
] |
||||
|
||||
test facts_grapheme_recorded_per_console {grapheme_cluster_support returns a recorded per-console fact without querying}\ |
||||
-setup $pipe_setup -body { |
||||
set spec [list $rd $wr] |
||||
punk::console::console_fact_set $spec grapheme_cluster_support {available 1 mode set} |
||||
lappend result [punk::console::grapheme_cluster_support -console $spec] |
||||
#no query emission may have occurred |
||||
lappend result [read $rd] |
||||
}\ |
||||
-cleanup [string cat { |
||||
set ::punk::console::console_facts [dict create] |
||||
} $pipe_cleanup]\ |
||||
-result [list\ |
||||
{available 1 mode set}\ |
||||
{}\ |
||||
] |
||||
|
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary. |
||||
@ -0,0 +1,321 @@
|
||||
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- |
||||
package require opunk::console 999999.0a1.0- |
||||
|
||||
#Tests for the emit-side '-console' args-tail convention: emit functions (punk::console::ansi::*, |
||||
#mouse/paste toggles, vt52, set_tabstop_width, titleset, move, test probes) accept an optional |
||||
#trailing '-console <consolespec>' pair parsed by punk::console::internal::opt_console_out and |
||||
#friends, writing to the resolved console's output channel instead of hardcoded stdout. |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
variable common { |
||||
set result "" |
||||
} |
||||
#out-capture pipe pair: emit procs write to $wr, tests read from $rd. |
||||
#lf translation both ends so byte-compares survive windows crlf channel defaults. |
||||
variable pipe_setup { |
||||
set result "" |
||||
lassign [chan pipe] rd wr |
||||
chan configure $wr -buffering none -translation lf |
||||
chan configure $rd -blocking 0 -translation lf |
||||
} |
||||
variable pipe_cleanup { |
||||
catch {chan close $wr} |
||||
catch {chan close $rd} |
||||
array unset ::punk::console::input_chunks_waiting $rd |
||||
} |
||||
|
||||
#On windows, bytes written to one end of a [chan pipe] pair are moved to the read side by a |
||||
#background reader thread - an immediate non-blocking read can race it and see nothing. |
||||
#Poll with a deadline, then drain briefly so multi-write emissions arrive whole. |
||||
proc read_emitted {chan {timeout_ms 2000}} { |
||||
set data "" |
||||
set deadline [expr {[clock milliseconds] + $timeout_ms}] |
||||
while {[clock milliseconds] < $deadline} { |
||||
append data [read $chan] |
||||
if {$data ne ""} { |
||||
after 20 |
||||
append data [read $chan] |
||||
return $data |
||||
} |
||||
after 5 |
||||
} |
||||
return $data |
||||
} |
||||
|
||||
test emit_helper_forms {opt_console_out/opt_console_channels resolve tails; junk tails error}\ |
||||
-setup $common -body { |
||||
lappend result [punk::console::internal::opt_console_out {}] |
||||
lappend result [punk::console::internal::opt_console_out [list -console {chana chanb}]] |
||||
lappend result [punk::console::internal::opt_console_channels {}] |
||||
lappend result [punk::console::internal::opt_console_channels [list -console {chana chanb}]] |
||||
lappend result [catch {punk::console::internal::opt_console_out {junk}}] |
||||
lappend result [catch {punk::console::internal::opt_console_out {-console {a b} extra}}] |
||||
#var forms leave non-console tails alone |
||||
set tail [list 1 2 X] |
||||
lappend result [punk::console::internal::opt_console_out_var tail] |
||||
lappend result $tail |
||||
set tail [list 1 2 X -console {chana chanb}] |
||||
lappend result [punk::console::internal::opt_console_out_var tail] |
||||
lappend result $tail |
||||
}\ |
||||
-result [list\ |
||||
stdout\ |
||||
chanb\ |
||||
{stdin stdout}\ |
||||
{chana chanb}\ |
||||
1\ |
||||
1\ |
||||
stdout\ |
||||
{1 2 X}\ |
||||
chanb\ |
||||
{1 2 X}\ |
||||
] |
||||
|
||||
test emit_clear_console_pair {ansi::clear writes to the spec'd console output channel}\ |
||||
-setup $pipe_setup -body { |
||||
punk::console::ansi::clear -console [list $rd $wr] |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::clear]}] |
||||
#imported alias in punk::console namespace takes the same tail |
||||
punk::console::clear -console [list $rd $wr] |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::clear]}] |
||||
}\ |
||||
-cleanup $pipe_cleanup\ |
||||
-result [list\ |
||||
1\ |
||||
1\ |
||||
] |
||||
|
||||
test emit_sugar_bytes {one-line emit wrappers write expected sequences to the spec'd console}\ |
||||
-setup $pipe_setup -body { |
||||
set spec [list $rd $wr] |
||||
punk::console::ansi::move_forward 3 -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::move_forward 3]}] |
||||
punk::console::ansi::move_row 7 -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::move_row 7]}] |
||||
punk::console::ansi::insert_spaces 5 -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq "\x1b\[5@"}] |
||||
punk::console::ansi::delete_lines 2 -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq "\x1b\[2M"}] |
||||
punk::console::ansi::cursor_save_dec -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq "\x1b7"}] |
||||
punk::console::ansi::cursor_restore_dec -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq "\x1b8"}] |
||||
punk::console::ansi::scroll_up 4 -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::scroll_up 4]}] |
||||
punk::console::ansi::enable_alt_screen -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::enable_alt_screen]}] |
||||
punk::console::ansi::test_decaln -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::test_decaln]}] |
||||
}\ |
||||
-cleanup $pipe_cleanup\ |
||||
-result [list\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
] |
||||
|
||||
test emit_vt52_branch {vt52-aware wrappers emit vt52 sequences to the spec'd console when its per-console is_vt52 fact is set}\ |
||||
-setup $pipe_setup\ |
||||
-body { |
||||
set spec [list $rd $wr] |
||||
punk::console::console_fact_set $spec is_vt52 1 |
||||
punk::console::ansi::cursor_off -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::vt52cursor_off]}] |
||||
punk::console::ansi::move_up 2 -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::vt52move_up 2]}] |
||||
punk::console::console_fact_set $spec is_vt52 0 |
||||
punk::console::ansi::cursor_off -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::cursor_off]}] |
||||
}\ |
||||
-cleanup [string cat { |
||||
set ::punk::console::console_facts [dict create] |
||||
} $pipe_cleanup]\ |
||||
-result [list\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
] |
||||
|
||||
test emit_move_toplevel {top-level punk::console::move emits the ansi::move sequence to the spec'd console}\ |
||||
-setup $pipe_setup -body { |
||||
punk::console::move 5 10 -console [list $rd $wr] |
||||
lappend result [expr {[read_emitted $rd] eq [punk::console::ansi::move 5 10]}] |
||||
}\ |
||||
-cleanup $pipe_cleanup\ |
||||
-result [list\ |
||||
1\ |
||||
] |
||||
|
||||
test emit_mouse_paste_toggles {mouse/paste toggles write their sequences to the spec'd console}\ |
||||
-setup $pipe_setup -body { |
||||
set spec [list $rd $wr] |
||||
punk::console::enable_mouse -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq "\x1b\[?1000h\x1b\[?1003h\x1b\[?1015h\x1b\[?1006h"}] |
||||
punk::console::disable_mouse -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq "\x1b\[?1000l\x1b\[?1003l\x1b\[?1015l\x1b\[?1006l"}] |
||||
punk::console::enable_mouse_sgr -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq "\x1b\[?1000h\x1b\[?1003h\x1b\[?1016h"}] |
||||
punk::console::enable_bracketed_paste -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq "\x1b\[?2004h"}] |
||||
punk::console::disable_bracketed_paste -console $spec |
||||
lappend result [expr {[read_emitted $rd] eq "\x1b\[?2004l"}] |
||||
}\ |
||||
-cleanup $pipe_cleanup\ |
||||
-result [list\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
] |
||||
|
||||
test emit_move_emit_triples {move_emit accepts extra row col data triples ahead of the -console tail}\ |
||||
-setup $pipe_setup -body { |
||||
punk::console::ansi::move_emit 1 1 A 2 2 B -console [list $rd $wr] |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::move_emit 1 1 A 2 2 B]}] |
||||
#no duplication of triples (regression check for the pre-0.1.8 args re-expansion class of bug) |
||||
punk::console::ansi::cursorsave_move_emit_return 3 4 C 5 6 D -console [list $rd $wr] |
||||
set expected [punk::ansi::cursor_save_dec][punk::ansi::move_emit 3 4 C][punk::ansi::move_emit 5 6 D][punk::ansi::cursor_restore_dec] |
||||
lappend result [expr {[read_emitted $rd] eq $expected}] |
||||
}\ |
||||
-cleanup $pipe_cleanup\ |
||||
-result [list\ |
||||
1\ |
||||
1\ |
||||
] |
||||
|
||||
test emit_spec_instance_name {anchored opunk::console instance name works as an emit -console spec}\ |
||||
-setup $pipe_setup -body { |
||||
opunk::console::create emittest1 $rd $wr |
||||
punk::console::ansi::clear_all -console emittest1 |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::clear_all]}] |
||||
}\ |
||||
-cleanup [string cat { |
||||
catch {opunk::console::forget emittest1} |
||||
} $pipe_cleanup]\ |
||||
-result [list\ |
||||
1\ |
||||
] |
||||
|
||||
test emit_spec_object_value {::opunk::Console object value works as an emit -console spec}\ |
||||
-setup $pipe_setup -body { |
||||
set obj [::opunk::Console::new $rd $wr] |
||||
punk::console::ansi::clear_scrollback -console $obj |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::clear_scrollback]}] |
||||
}\ |
||||
-cleanup $pipe_cleanup\ |
||||
-result [list\ |
||||
1\ |
||||
] |
||||
|
||||
test emit_titleset {titleset routes through the ansi mechanism to the spec'd console}\ |
||||
-setup [string cat $pipe_setup { |
||||
set saved_ansi_wanted $::punk::console::ansi_wanted |
||||
set ::punk::console::ansi_wanted 2 |
||||
}]\ |
||||
-body { |
||||
punk::console::titleset "emit test title" -console [list $rd $wr] |
||||
lappend result [expr {[read_emitted $rd] eq [punk::ansi::titleset "emit test title"]}] |
||||
}\ |
||||
-cleanup [string cat { |
||||
set ::punk::console::ansi_wanted $saved_ansi_wanted |
||||
} $pipe_cleanup]\ |
||||
-result [list\ |
||||
1\ |
||||
] |
||||
|
||||
test emit_move_emit_return_query {move_emit_return queries cursor position on the spec'd console and emits there}\ |
||||
-setup [string cat $common { |
||||
#full in/out pipe pairs: rdi/wri feeds the console 'input', wro/rdo captures 'output' |
||||
lassign [chan pipe] rdi wri |
||||
lassign [chan pipe] rdo wro |
||||
chan configure $wri -buffering none -translation lf |
||||
chan configure $wro -buffering none -translation lf |
||||
chan configure $rdo -blocking 0 -translation lf |
||||
}]\ |
||||
-body { |
||||
#deliver a cursor position report after the query is emitted (as a real terminal would) |
||||
after 40 [list apply [list {wchan} { |
||||
puts -nonewline $wchan "\x1b\[10;5R" |
||||
flush $wchan |
||||
}] $wri] |
||||
punk::console::ansi::move_emit_return 2 3 X -console [list $rdi $wro] |
||||
set data [read_emitted $rdo] |
||||
#output: the CSI 6n cursor query, then the emit commands with return-move to 9;5 |
||||
#(orig_row decremented by 1 in the not-raw path) |
||||
set expected "\x1b\[6n[punk::ansi::move_emit 2 3 X][punk::ansi::move 9 5]" |
||||
lappend result [expr {$data eq $expected}] |
||||
}\ |
||||
-cleanup { |
||||
foreach c [list $wri $rdi $wro $rdo] { |
||||
catch {chan close $c} |
||||
} |
||||
array unset ::punk::console::input_chunks_waiting $rdi |
||||
}\ |
||||
-result [list\ |
||||
1\ |
||||
] |
||||
|
||||
#get_size consults env(TERM_PROGRAM)/env(MSYSTEM) as mintty-without-winpty hints - clear them |
||||
#so the pipe pair is treated as a non-terminal and no ANSI size queries land on the out pipe. |
||||
variable hints_save { |
||||
set saved_hints [dict create] |
||||
foreach ev {TERM_PROGRAM MSYSTEM} { |
||||
if {[info exists ::env($ev)]} { |
||||
dict set saved_hints $ev [set ::env($ev)] |
||||
unset ::env($ev) |
||||
} |
||||
} |
||||
} |
||||
variable hints_restore { |
||||
dict for {ev val} $saved_hints { |
||||
set ::env($ev) $val |
||||
} |
||||
} |
||||
|
||||
test emit_set_tabstop_width {set_tabstop_width emits tabstop sequences to the spec'd console}\ |
||||
-setup [string cat $pipe_setup $hints_save]\ |
||||
-body { |
||||
#get_size on a plain pipe pair falls back through tput to the 80x24 default - either |
||||
#way a clear_all_tabstops followed by at least one set_tabstop must land on the pipe |
||||
punk::console::set_tabstop_width 8 -console [list $rd $wr] |
||||
set data [read_emitted $rd] |
||||
lappend result [expr {[string first [punk::ansi::clear_all_tabstops] $data] == 0}] |
||||
lappend result [expr {[string first [punk::ansi::set_tabstop] $data] > 0}] |
||||
}\ |
||||
-cleanup [string cat $hints_restore $pipe_cleanup]\ |
||||
-result [list\ |
||||
1\ |
||||
1\ |
||||
] |
||||
|
||||
test emit_error_tails {junk trailing arguments are rejected by the strict emit tails}\ |
||||
-setup $common -body { |
||||
lappend result [catch {punk::console::ansi::clear junk}] |
||||
lappend result [catch {punk::console::ansi::move_forward 3 junk}] |
||||
lappend result [catch {punk::console::enable_mouse -console}] |
||||
lappend result [catch {punk::console::vt52 notabool}] |
||||
}\ |
||||
-result [list\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
1\ |
||||
] |
||||
|
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary. |
||||
Loading…
Reference in new issue