diff options
Diffstat (limited to 'tests/main.test')
| -rw-r--r-- | tests/main.test | 169 |
1 files changed, 122 insertions, 47 deletions
diff --git a/tests/main.test b/tests/main.test index 12afa46..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.13.2.4 2006/09/04 21:36:55 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]} @@ -139,6 +121,72 @@ namespace eval ::tcl::test::main { } -result [list [list [encoding convertfrom [encoding system] \ [encoding convertto [encoding system] \u20ac]]] {} 0]\n + test Tcl_Main-1.7 { + Tcl_Main: startup script - -encoding option + } -constraints { + stdio + } -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + chan configure $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] -encoding utf-8 script]" r]} + } -body { + read $f + } -cleanup { + close $f + removeFile script + } -result [list script {} 0]\n1\n + + test Tcl_Main-1.8 { + Tcl_Main: startup script - -encoding option - mismatched encodings + } -constraints { + stdio + } -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + chan configure $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] -encoding ascii script]" r]} + } -body { + read $f + } -cleanup { + close $f + removeFile script + } -result [list script {} 0]\n0\n + + test Tcl_Main-1.9 { + Tcl_Main: startup script - -encoding option - no abbrevation + } -constraints { + stdio + } -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + chan configure $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 + } + list [catch {gets $f} line] $line + } -cleanup { + close $f + removeFile script + } -result {0 {-enc utf-8 script}} + # Tests Tcl_Main-2.*: application-initialization procedure test Tcl_Main-2.1 { @@ -500,24 +548,24 @@ namespace eval ::tcl::test::main { \nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-4.5 { - Tcl_Main: Bug 1481986 + Tcl_Main: Bug 1481986 } -constraints { - exec Tcltest + exec Tcltest } -setup { - set rc [makeFile { - testsetmainloop - after 0 {puts "Event callback"} - } rc] + 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 + set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+] + after 1000 + type $f {puts {Interactive output} + exit + } + read $f } -cleanup { - catch {close $f} - removeFile rc + catch {close $f} + removeFile rc } -result "Event callback\nInteractive output\n" # Tests Tcl_Main-5.*: interactive operations @@ -544,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 @@ -558,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 @@ -584,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 @@ -702,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 @@ -763,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 { @@ -923,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] @@ -1146,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 { |