diff options
Diffstat (limited to 'tests/main.test')
-rw-r--r-- | tests/main.test | 99 |
1 files changed, 82 insertions, 17 deletions
diff --git a/tests/main.test b/tests/main.test index 3799be7..1d33fbb 100644 --- a/tests/main.test +++ b/tests/main.test @@ -9,28 +9,93 @@ # All rights reserved. package require tcltest 2.1 -namespace import -force tcltest::configure -namespace import -force tcltest::testsDirectory -configure -testdir [file join [pwd] [file dirname [info script]]] -configure -loadfile [file join [testsDirectory] constraints.tcl] +eval tcltest::configure $argv tcltest::loadTestedCommands -namespace import -force tcltest::interpreter -namespace import -force tcltest::makeFile -namespace import -force tcltest::removeFile - -test main-1.1 {StdinProc} {unix} { +test main-1.1 {StdinProc} -constraints stdio -setup { set script [makeFile { close stdin; exit } script] - if {[catch {exec [interpreter] <$script} msg]} { - set error 1 - } else { - set error 0 - } +} -body { + list [catch {exec [interpreter] <$script} msg] $msg +} -cleanup { removeFile script - list $error $msg -} {0 {}} +} -result {0 {}} + +test main-2.1 {Tk_MainEx: -encoding option} -constraints { + stdio + } -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]; exit" + close $f + catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]} + } -body { + read $f + } -cleanup { + close $f + removeFile script + } -result [list script {} 0]\n1\n + +test main-2.2 {Tk_MainEx: -encoding option} -constraints { + stdio + } -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]; exit" + close $f + catch {set f [open "|[list [interpreter] -encoding ascii script]" r]} + } -body { + read $f + } -cleanup { + close $f + removeFile script + } -result [list script {} 0]\n0\n + + # Procedure to simulate interactive typing of commands, line by line + proc type {chan script} { + foreach line [split $script \n] { + if {[catch { + puts $chan $line + flush $chan + }]} { + return + } + # Grrr... Behavior depends on this value. + after 1000 + } + } + +test main-2.3 {Tk_MainEx: -encoding option} -constraints { + stdio + } -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]" + close $f + catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]} + } -body { + type $f { + puts $argv + exit + } + list [catch {gets $f} line] $line + } -cleanup { + close $f + removeFile script + } -result {0 {-enc utf-8 script}} test main-3.1 {Tk_ParseArgv: -help option} -constraints unix -body { # Run only on unix as Win32 pops up native dialog @@ -57,5 +122,5 @@ test main-3.3 {Tk_ParseArgv: -help option} -setup { } -match glob -result {1 {Command-specific options:*}} # cleanup -::tcltest::cleanupTests +cleanupTests return |