diff options
| -rw-r--r-- | tests/winConsole.test | 105 | ||||
| -rw-r--r-- | win/tclWinConsole.c | 74 |
2 files changed, 136 insertions, 43 deletions
diff --git a/tests/winConsole.test b/tests/winConsole.test index 795e16d..ae0d939 100644 --- a/tests/winConsole.test +++ b/tests/winConsole.test @@ -34,25 +34,24 @@ proc yesno {question {default "Y"}} { } proc prompt {prompt} { - set answer "" - # Make sure we are seen but catch because ui and console + # 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" - return [gets stdin] + flush stdout } +# Input tests -test winConsole-1.0 {Console blocking gets} -constraints {win interactive xx} -body { - set response [prompt "Type a line of text and press Return\n"] - yesno "Did you type \"$response\"" -} -result 1 +test console-gets-1.0 {Console blocking gets} -constraints {win interactive} -body { + set response [prompt "Type \"xyz\" and hit Enter: "] + gets stdin +} -result xyz -test winConsole-1.1 {Console file channel: non-blocking gets} {win interactive} { +test console-gets-1.1 {Console file channel: non-blocking gets} {win interactive} { set oldmode [fconfigure stdin] - puts stdout "Enter abcdef<return> now: " nonewline - flush stdout + set response [prompt "Type \"abc\" and hit Enter: "] fileevent stdin readable { if {[gets stdin line] >= 0} { set result $line @@ -72,9 +71,93 @@ test winConsole-1.1 {Console file channel: non-blocking gets} {win interactive} set result -} "abcdef" +} abc + +# Output tests + +test console-puts-1.0 {Console blocking puts stdout} -constraints {win interactive} -body { + puts stdout "123" + yesno "Did you see the string \"123\"?" +} -result 1 +test console-puts-1.1 {Console blocking puts stderr} -constraints {win interactive} -body { + puts stderr "456" + yesno "Did you see the string \"456\"?" +} -result 1 +# fconfigure tests + +## stdin + +test console-fconfigure-1.0 { + Console get stdin configuration +} -constraints {win interactive} -body { + lsort [dict keys [fconfigure stdin]] +} -result {-blocking -buffering -buffersize -encoding -eofchar -inputmode -translation} + +set testnum 0 +foreach {opt result} { + -blocking 1 + -buffering line + -buffersize 4096 + -encoding utf-16 + -inputmode normal + -translation auto +} { + test console-fconfigure-1.[incr testnum] "Console get stdin option $opt" \ + -constraints {win interactive} -body { + fconfigure stdin $opt + } -result $result +} +test console-fconfigure-1.[incr testnum] { + Console get stdin option -eofchar +} -constraints {win interactive} -body { + fconfigure stdin -eofchar +} -result \x1a + +test console-fconfigure-1.[incr testnum] { + fconfigure -inputmode password +} -constraints {win interactive} -body { + prompt "Type \"password\" and hit Enter. You should NOT see characters echoed" + fconfigure stdin -inputmode password + gets stdin password + set password_echoed [yesno "Were the characters echoed?"] + prompt "Type \"normal\" and hit Enter. You should see characters echoed" + fconfigure stdin -inputmode normal + gets stdin normal + set normal_echoed [yesno "Were the characters echoed?"] + list $password_echoed $password $normal_echoed $normal + +} -result [list 0 password 1 normal] + +## stdout/stderr +foreach chan {stdout stderr} major {2 3} { + test console-fconfigure-$major.0 "Console get $chan configuration" -constraints { + win interactive + } -body { + lsort [dict keys [fconfigure $chan]] + } -result {-blocking -buffering -buffersize -encoding -eofchar -translation -winsize} + set testnum 0 + foreach {opt result} { + -blocking 1 + -buffersize 4096 + -encoding utf-16 + -translation crlf + } { + test console-fconfigure-$major.[incr testnum] "Console get $chan option $opt" \ + -constraints {win interactive} -body { + fconfigure $chan $opt + } -result $result + } + + test console-fconfigure-$major.[incr testnum] "Console get $chan option -winsize" -constraints {win interactive} -body { + fconfigure $chan -winsize + } -result {\d+ \d+} -match regexp + + test console-fconfigure-$major.[incr testnum] "Console get $chan option -buffering" -constraints {win interactive} -body { + fconfigure $chan -buffering + } -result [expr {$chan eq "stdout" ? "line" : "none"}] +} #cleanup diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 653d580..7ca94ce 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -54,15 +54,14 @@ static int initialized = 0; -#ifdef TCL_CONSOLE_DEBUG -#ifndef CONSOLE_BUFFER_SIZE /* - * Force tiny to stress synchronization. Must be at least 2*sizeof(WCHAR) :-) - * to work around Tcl channel bug https://core.tcl-lang.org/tcl/tktview/b3977d199b08e3979a8da970553d5209b3042e9c + * Permit CONSOLE_BUFFER_SIZE to be defined on build command for stress test. + * + * In theory, at least sizeof(WCHAR) but note the Tcl channel bug + * https://core.tcl-lang.org/tcl/tktview/b3977d199b08e3979a8da970553d5209b3042e9c + * will cause failures in test suite if close to max input line in the suite. */ -#define CONSOLE_BUFFER_SIZE (2*sizeof(WCHAR)) -#endif -#else +#ifndef CONSOLE_BUFFER_SIZE #define CONSOLE_BUFFER_SIZE 8000 /* In bytes */ #endif @@ -1161,7 +1160,7 @@ ConsoleInputProc( * holds a reference count on handleInfoPtr, it will not * be deallocated while the lock is released. */ - //WakeConditionVariable(&handleInfoPtr->consoleThreadCV); TODO - Needed? + // WakeConditionVariable(&handleInfoPtr->consoleThreadCV); // TODO - Needed? if (!SleepConditionVariableSRW(&handleInfoPtr->interpThreadCV, &handleInfoPtr->lock, INFINITE, @@ -2263,41 +2262,52 @@ ConsoleGetOptionProc( } } } + else { + /* + * Output channel. Get option -winsize + * Option is readonly and returned by [fconfigure chan -winsize] but not + * returned by [fconfigure chan] without explicit option name. + */ + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-winsize"); + } - /* - * Get option -winsize - * Option is readonly and returned by [fconfigure chan -winsize] but not - * returned by [fconfigure chan] without explicit option name. - */ - - if ((len > 1) && (strncmp(optionName, "-winsize", len) == 0)) { - CONSOLE_SCREEN_BUFFER_INFO consoleInfo; + if (len == 0 || (len > 1 && strncmp(optionName, "-winsize", len) == 0)) { + CONSOLE_SCREEN_BUFFER_INFO consoleInfo; - valid = 1; - if (!GetConsoleScreenBufferInfo(chanInfoPtr->handle, &consoleInfo)) { - Tcl_WinConvertError(GetLastError()); - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read console size: %s", - Tcl_PosixError(interp))); + valid = 1; + if (!GetConsoleScreenBufferInfo(chanInfoPtr->handle, + &consoleInfo)) { + Tcl_WinConvertError(GetLastError()); + if (interp != NULL) { + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("couldn't read console size: %s", + Tcl_PosixError(interp))); + } + return TCL_ERROR; } - return TCL_ERROR; + Tcl_DStringStartSublist(dsPtr); + sprintf(buf, + "%d", + consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1); + Tcl_DStringAppendElement(dsPtr, buf); + sprintf(buf, + "%d", + consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1); + Tcl_DStringAppendElement(dsPtr, buf); + Tcl_DStringEndSublist(dsPtr); } - sprintf(buf, "%d", - consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1); - Tcl_DStringAppendElement(dsPtr, buf); - sprintf(buf, "%d", - consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1); - Tcl_DStringAppendElement(dsPtr, buf); } + if (valid) { return TCL_OK; } if (chanInfoPtr->flags & CONSOLE_READ_OPS) { - return Tcl_BadChannelOption(interp, optionName, "inputmode winsize"); + return Tcl_BadChannelOption(interp, optionName, "inputmode"); } else { - return Tcl_BadChannelOption(interp, optionName, ""); + return Tcl_BadChannelOption(interp, optionName, "winsize"); } } |