summaryrefslogtreecommitdiffstats
path: root/tests/winConsole.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/winConsole.test')
-rw-r--r--tests/winConsole.test345
1 files changed, 336 insertions, 9 deletions
diff --git a/tests/winConsole.test b/tests/winConsole.test
index 9075ff3..3f23c07 100644
--- a/tests/winConsole.test
+++ b/tests/winConsole.test
@@ -4,7 +4,7 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1999 by Scriptics Corporation.
+# Copyright © 1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -14,34 +14,361 @@ if {"::tcltest" ni [namespace children]} {
namespace import -force ::tcltest::*
}
+catch {package require twapi} ;# Only to bring window to foreground. Not critical
-test winConsole-1.1 {Console file channel: non-blocking gets} {win interactive} {
- set oldmode [fconfigure stdin]
+::tcltest::ConstraintInitializer haveThread { expr {![catch {package require Thread}]} }
+
+# Prompt user for a yes/no response
+proc yesno {question {default "Y"}} {
+ set answer ""
+ # Make sure we are seen but catch because ui and console
+ # packages may not be available
+ catch {twapi::set_foreground_window [twapi::get_console_window]}
+ while {![string is boolean -strict $answer]} {
+ puts -nonewline stdout "$question Type Y/N followed by Enter \[$default\] : "
+ flush stdout
+ set answer [string trim [gets stdin]]
+ if {$answer eq ""} {
+ set answer $default
+ }
+ }
+ return [expr {!! $answer}]
+}
- puts stdout "Enter abcdef<return> now: " nonewline
+proc prompt {prompt} {
+ # Make sure we are seen but catch because twapi ui and console
+ # packages may not be available
+ catch {twapi::set_foreground_window [twapi::get_console_window]}
+ puts -nonewline stdout "$prompt"
flush stdout
+}
+
+# Input tests
+
+test console-input-1.0 {Console blocking gets} -constraints {win interactive} -body {
+ prompt "Type \"xyz\" and hit Enter: "
+ gets stdin
+} -result xyz
+
+test console-input-1.1 {Console file channel: non-blocking gets} -constraints {
+ win interactive
+} -setup {
+ unset -nocomplain result
+ unset -nocomplain result2
+} -body {
+ set oldmode [fconfigure stdin]
+
+ prompt "Type \"abc\" and hit Enter: "
fileevent stdin readable {
if {[gets stdin line] >= 0} {
- set result $line
- } else {
+ lappend result2 $line
+ if {[llength $result2] > 1} {
+ set result $result2
+ } else {
+ prompt "Type \"def\" and hit Enter: "
+ }
+ } elseif {[eof stdin]} {
set result "gets failed"
}
}
fconfigure stdin -blocking 0 -buffering line
- set result {}
vwait result
#cleanup the fileevent
fileevent stdin readable {}
fconfigure stdin {*}$oldmode
+ set result
+
+} -result {abc def}
+
+test console-input-1.1.1 {Bug baa51423c28a: Console file channel: fileevent with blocking gets} -constraints {
+ win interactive
+} -setup {
+ unset -nocomplain result
+ unset -nocomplain result2
+} -body {
+ prompt "Type \"abc\" and hit Enter: "
+ fileevent stdin readable {
+ if {[gets stdin line] >= 0} {
+ lappend result2 $line
+ if {[llength $result2] > 1} {
+ set result $result2
+ } else {
+ prompt "Type \"def\" and hit Enter: "
+ }
+ } elseif {[eof stdin]} {
+ set result "gets failed"
+ }
+ }
+
+ vwait result
+ #cleanup the fileevent
+ fileevent stdin readable {}
+ set result
+
+} -result {abc def}
+
+test console-input-2.0 {Console blocking read} -constraints {win interactive} -setup {
+ set oldmode [fconfigure stdin]
+ fconfigure stdin -inputmode raw
+} -cleanup {
+ fconfigure stdin {*}$oldmode
+} -body {
+ prompt "Type the key \"a\". Do NOT hit Enter. You will NOT see characters echoed."
+ set c [read stdin 1]
+ puts ""
+ set c
+} -result a
+
+test console-input-2.1 {Console file channel: non-blocking read} -constraints {
+ win interactive
+} -setup {
+ set oldmode [fconfigure stdin]
+} -cleanup {
+ fconfigure stdin {*}$oldmode
+ puts ""; # Because CRLF also would not have been echoed
+} -body {
+ set input ""
+ fconfigure stdin -blocking 0 -buffering line -inputmode raw
+ prompt "Type \"abc\". Do NOT hit Enter. You will NOT see characters echoed."
+
+ fileevent stdin readable {
+ set c [read stdin 1]
+ if {$c eq ""} {
+ if {[eof stdin]} {
+ set result "read eof"
+ }
+ } else {
+ append input $c
+ if {[string length $input] == 3} {
+ set result $input
+ }
+ }
+ }
+
+ set result {}
+ vwait result
+ fileevent stdin readable {}
set result
+} -result abc
+
+# Output tests
+
+test console-output-1.0 {Console blocking puts stdout} -constraints {win interactive} -body {
+ puts stdout "123"
+ yesno "Did you see the string \"123\"?"
+} -result 1
+
+test console-output-1.1 {Console non-blocking puts stdout} -constraints {
+ win interactive
+} -setup {
+ set oldmode [fconfigure stdout]
+ dict unset oldmode -winsize
+} -cleanup {
+ fconfigure stdout {*}$oldmode
+} -body {
+ fconfigure stdout -blocking 0 -buffering line
+ set count 0
+ fileevent stdout writable {
+ if {[incr count] < 4} {
+ puts "$count"
+ } else {
+ fileevent stdout writable {}
+ set done 1
+ }
+ }
+ vwait done
+ yesno "Did you see 1, 2, 3 printed on consecutive lines?"
+} -result 1
+
+test console-output-2.0 {Console blocking puts stderr} -constraints {win interactive} -body {
+ puts stderr "456"
+ yesno "Did you see the string \"456\"?"
+} -result 1
+
+
+# fconfigure get tests
+
+## fconfigure get stdin
+
+test console-fconfigure-get-1.0 {
+ Console get stdin configuration
+} -constraints {win interactive} -body {
+ lsort [dict keys [fconfigure stdin]]
+} -result {-blocking -buffering -buffersize -encoding -eofchar -inputmode -profile -translation}
+
+set testnum 0
+foreach {opt result} {
+ -blocking 1
+ -buffering line
+ -buffersize 4096
+ -encoding utf-16
+ -inputmode normal
+ -translation auto
+} {
+ test console-fconfigure-get-1.[incr testnum] "Console get stdin option $opt" \
+ -constraints {win interactive} -body {
+ fconfigure stdin $opt
+ } -result $result
+}
+test console-fconfigure-get-1.[incr testnum] {
+ Console get stdin option -eofchar
+} -constraints {win interactive} -body {
+ fconfigure stdin -eofchar
+} -result \x1A
+
+test console-fconfigure-get-1.[incr testnum] {
+ fconfigure -winsize
+} -constraints {win interactive} -body {
+ fconfigure stdin -winsize
+} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -inputmode} -returnCodes error
+
+## fconfigure get stdout/stderr
+foreach chan {stdout stderr} major {2 3} {
+ test console-fconfigure-get-$major.0 "Console get $chan configuration" -constraints {
+ win interactive
+ } -body {
+ lsort [dict keys [fconfigure $chan]]
+ } -result {-blocking -buffering -buffersize -encoding -eofchar -profile -translation -winsize}
+ set testnum 0
+ foreach {opt result} {
+ -blocking 1
+ -buffersize 4096
+ -encoding utf-16
+ -translation crlf
+ } {
+ test console-fconfigure-get-$major.[incr testnum] "Console get $chan option $opt" \
+ -constraints {win interactive} -body {
+ fconfigure $chan $opt
+ } -result $result
+ }
+
+ test console-fconfigure-get-$major.[incr testnum] "Console get $chan option -winsize" \
+ -constraints {win interactive} -body {
+ fconfigure $chan -winsize
+ } -result {\d+ \d+} -match regexp
+
+ test console-fconfigure-get-$major.[incr testnum] "Console get $chan option -buffering" \
+ -constraints {win interactive} -body {
+ fconfigure $chan -buffering
+ } -result [expr {$chan eq "stdout" ? "line" : "none"}]
+
+ test console-fconfigure-get-$major.[incr testnum] {
+ fconfigure -inputmode
+ } -constraints {win interactive} -body {
+ fconfigure $chan -inputmode
+ } -result {bad option "-inputmode": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -winsize} -returnCodes error
+
+}
+
+## fconfigure set stdin
+
+test console-fconfigure-set-1.0 {
+ fconfigure -inputmode password
+} -constraints {win interactive} -body {
+ set result {}
+
+ prompt "Type \"pass\" and hit Enter. You should NOT see characters echoed: "
+ fconfigure stdin -inputmode password
+ lappend result [gets stdin]
+ lappend result [fconfigure stdin -inputmode]
+ fconfigure stdin -inputmode normal
+ lappend result [yesno "\nWere the characters echoed?"]
+
+ prompt "Type \"norm\" and hit Enter. You should see characters echoed: "
+ lappend result [gets stdin]
+ lappend result [fconfigure stdin -inputmode]
+ lappend result [yesno "Were the characters echoed?"]
+
+ set result
+} -result [list pass password 0 norm normal 1]
+
+test console-fconfigure-set-1.1 {
+ fconfigure -inputmode raw
+} -constraints {win interactive} -body {
+ set result {}
+
+ prompt "Type the keys \"a\", Ctrl-H, \"b\". Do NOT hit Enter. You should NOT see characters echoed: "
+ fconfigure stdin -inputmode raw
+ lappend result [read stdin 3]
+ lappend result [fconfigure stdin -inputmode]
+ fconfigure stdin -inputmode normal
+ lappend result [yesno "\nWere the characters echoed?"]
+
+ prompt "Type the keys \"c\", Ctrl-H, \"d\" and hit Enter. You should see characters echoed: "
+ lappend result [gets stdin]
+ lappend result [fconfigure stdin -inputmode]
+ lappend result [yesno "Were the characters echoed (c replaced by d)?"]
+
+ set result
+} -result [list a\x08b raw 0 d normal 1]
+
+test console-fconfigure-set-1.2 {
+ fconfigure -inputmode reset
+} -constraints {win interactive} -body {
+ set result {}
+
+ prompt "Type \"pass\" and hit Enter. You should NOT see characters echoed: "
+ fconfigure stdin -inputmode password
+ lappend result [gets stdin]
+ lappend result [fconfigure stdin -inputmode]
+ fconfigure stdin -inputmode reset
+ lappend result [yesno "\nWere the characters echoed?"]
+
+ prompt "Type \"reset\" and hit Enter. You should see characters echoed: "
+ lappend result [gets stdin]
+ lappend result [fconfigure stdin -inputmode]
+ lappend result [yesno "Were the characters echoed?"]
+
+ set result
+} -result [list pass password 0 reset normal 1]
+
+test console-fconfigure-set-1.3 {
+ fconfigure stdin -winsize
+} -constraints {win interactive} -body {
+ fconfigure stdin -winsize {10 30}
+} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -inputmode} -returnCodes error
+
+## fconfigure set stdout,stderr
+
+test console-fconfigure-set-2.0 {
+ fconfigure stdout -winsize
+} -constraints {win interactive} -body {
+ fconfigure stdout -winsize {10 30}
+} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, or -translation} -returnCodes error
+
+test console-fconfigure-set-3.0 {
+ fconfigure stderr -winsize
+} -constraints {win interactive} -body {
+ fconfigure stderr -winsize {10 30}
+} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -profile, -translation} -returnCodes error
+
+# Multiple threads
-} "abcdef"
+test console-thread-input-1.0 {Get input in thread} -constraints {
+ win interactive haveThread
+} -setup {
+ set tid [thread::create]
+} -cleanup {
+ thread::release $tid
+} -body {
+ prompt "Type \"xyz\" and hit Enter: "
+ thread::send $tid {gets stdin}
+} -result xyz
-#cleanup
+test console-thread-output-1.0 {Output from thread} -constraints {
+ win interactive haveThread
+} -setup {
+ set tid [thread::create]
+} -cleanup {
+ thread::release $tid
+} -body {
+ thread::send $tid {puts [thread::id]}
+ yesno "Did you see $tid printed?"
+} -result 1
::tcltest::cleanupTests
return