diff options
Diffstat (limited to 'tests/main.test')
| -rw-r--r-- | tests/main.test | 123 |
1 files changed, 85 insertions, 38 deletions
diff --git a/tests/main.test b/tests/main.test index 30de5ed..351fd4f 100644 --- a/tests/main.test +++ b/tests/main.test @@ -1,6 +1,4 @@ # This file contains a collection of tests for generic/tclMain.c. -# -# RCS: @(#) $Id: main.test,v 1.15 2003/10/07 21:45:39 dgp Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -8,15 +6,7 @@ if {[catch {package require tcltest 2.0.2}]} { } namespace eval ::tcl::test::main { - - namespace import ::tcltest::test - namespace import ::tcltest::testConstraint - namespace import ::tcltest::interpreter - namespace import ::tcltest::cleanupTests - namespace import ::tcltest::makeFile - namespace import ::tcltest::removeFile - namespace import ::tcltest::temporaryDirectory - namespace import ::tcltest::workingDirectory + namespace import ::tcltest::* # Is [exec] defined? testConstraint exec [llength [info commands exec]] @@ -76,8 +66,6 @@ namespace eval ::tcl::test::main { } -result [list [interpreter] -script 0]\n test Tcl_Main-1.3 { - Tcl_Main: encoding of arguments: done by system encoding - Note the shortcoming explained in Tcl Feature Request 491789 } -constraints { stdio } -setup { @@ -92,10 +80,8 @@ namespace eval ::tcl::test::main { [encoding convertto [encoding system] \u00c0]]] 0]\n test Tcl_Main-1.4 { - Tcl_Main: encoding of arguments: done by system encoding - Note the shortcoming explained in Tcl Feature Request 491789 } -constraints { - stdio tempNotWin + stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script catch {set f [open "|[list [interpreter] script \u20ac]" r]} @@ -108,8 +94,6 @@ namespace eval ::tcl::test::main { [encoding convertto [encoding system] \u20ac]]] 0]\n test Tcl_Main-1.5 { - Tcl_Main: encoding of script name: system encoding loss - Note the shortcoming explained in Tcl Feature Request 491789 } -constraints { stdio } -setup { @@ -124,10 +108,8 @@ namespace eval ::tcl::test::main { [encoding convertto [encoding system] \u00c0]]] {} 0]\n test Tcl_Main-1.6 { - Tcl_Main: encoding of script name: system encoding loss - Note the shortcoming explained in Tcl Feature Request 491789 } -constraints { - stdio tempNotWin + stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac catch {set f [open "|[list [interpreter] \u20ac]" r]} @@ -147,7 +129,7 @@ namespace eval ::tcl::test::main { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 + chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" @@ -168,7 +150,7 @@ namespace eval ::tcl::test::main { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 + chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" @@ -189,7 +171,7 @@ namespace eval ::tcl::test::main { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 + chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" @@ -554,7 +536,7 @@ namespace eval ::tcl::test::main { } } rc] } -body { - exec [interpreter] << {puts "In script"} \ + exec [interpreter] << {} \ -appinitprocsetrcfile $rc >& result set f [open result] read $f @@ -563,7 +545,28 @@ namespace eval ::tcl::test::main { file delete result removeFile rc } -result "application-specific initialization failed:\ - \nIn script\nExit MainLoop\nIn exit\neven 0\n" + \nExit MainLoop\nIn exit\neven 0\n" + + test Tcl_Main-4.5 { + Tcl_Main: Bug 1481986 + } -constraints { + exec Tcltest + } -setup { + set rc [makeFile { + testsetmainloop + after 0 {puts "Event callback"} + } rc] + } -body { + set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+] + after 1000 + type $f {puts {Interactive output} + exit + } + read $f + } -cleanup { + catch {close $f} + removeFile rc + } -result "Event callback\nInteractive output\n" # Tests Tcl_Main-5.*: interactive operations @@ -589,7 +592,7 @@ namespace eval ::tcl::test::main { catch {set f [open "|[list [interpreter]]" w+]} } -body { type $f { - fconfigure stdin -blocking 0 + chan configure stdin -blocking 0 puts SUCCESS } list [catch {gets $f} line] $line @@ -603,20 +606,19 @@ namespace eval ::tcl::test::main { exec } -setup { catch {set f [open "|[list [interpreter]]" w+]} - catch {fconfigure $f -blocking 0} + catch {chan configure $f -blocking 0} } -body { - type $f "fconfigure stdin -eofchar \\032 + type $f "chan configure stdin -eofchar \\032 if 1 \{\n\032" variable wait - fileevent $f readable \ + chan event $f readable \ [list set [namespace which -variable wait] "child exit"] set id [after 2000 [list set [namespace which -variable wait] timeout]] vwait [namespace which -variable wait] after cancel $id set wait } -cleanup { - if {[string equal timeout $wait] - && [string equal unix $::tcl_platform(platform)]} { + if {$wait eq "timeout" && [testConstraint unix]} { exec kill [pid $f] } close $f @@ -629,18 +631,17 @@ namespace eval ::tcl::test::main { } -setup { set cmd {makeFile "if 1 \{" script} catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]} - catch {fconfigure $f -blocking 0} + catch {chan configure $f -blocking 0} } -body { variable wait - fileevent $f readable \ + chan event $f readable \ [list set [namespace which -variable wait] "child exit"] set id [after 2000 [list set [namespace which -variable wait] timeout]] vwait [namespace which -variable wait] after cancel $id set wait } -cleanup { - if {[string equal timeout $wait] - && [string equal unix $::tcl_platform(platform)]} { + if {$wait eq "timeout" && [testConstraint unix]} { exec kill [pid $f] } close $f @@ -747,7 +748,7 @@ namespace eval ::tcl::test::main { exec Tcltest } -setup { catch {set f [open "|[list [interpreter]]" w+]} - catch {fconfigure $f -blocking 0} + catch {chan configure $f -blocking 0} } -body { type $f "testsetmainloop after 2000 testexitmainloop @@ -808,6 +809,20 @@ namespace eval ::tcl::test::main { file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" + test Tcl_Main-5.13 { + Bug 1775878 + } -constraints { + exec + } -setup { + catch {set f [open "|[list [interpreter]]" w+]} + } -body { + type $f "puts \\" + type $f return + list [catch {gets $f} line] $line + } -cleanup { + close $f + } -result [list 0 return] + # Tests Tcl_Main-6.*: interactive operations with prompts test Tcl_Main-6.1 { @@ -906,6 +921,23 @@ namespace eval ::tcl::test::main { file delete result } -result "1\n% " + test Tcl_Main-6.7 { + [unknown]: interactive auto-completion. + } -constraints { + exec + } -body { + exec [interpreter] << { + proc foo\{ x {} + set ::auto_noexec xxx + set tcl_interactive 1 + foo y} >& result + set f [open result] + read $f + } -cleanup { + close $f + file delete result + } -result "1\n% % " + # Tests Tcl_Main-7.*: exiting test Tcl_Main-7.1 { @@ -951,7 +983,7 @@ namespace eval ::tcl::test::main { } -body { exec [interpreter] << { testsetmainloop - fconfigure stdin -blocking 0 + chan configure stdin -blocking 0 testexitmainloop } >& result set f [open result] @@ -1174,6 +1206,21 @@ namespace eval ::tcl::test::main { file delete result } -result "1\nExit MainLoop\n" + test Tcl_Main-8.13 { + Bug 1775878 + } -constraints { + exec Tcltest + } -setup { + catch {set f [open "|[list [interpreter]]" w+]} + } -body { + exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result + set f [open result] + read $f + } -cleanup { + close $f + file delete result + } -result "pwd\nExit MainLoop\n" + # Tests Tcl_Main-9.*: Prompt operations test Tcl_Main-9.1 { |