path: root/tests/winConsole.test

# This file tests the tclWinConsole.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

catch {package require twapi} ;# Only to bring window to foreground. Not critical

::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}]
}

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} {
	    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

    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

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

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