diff options
Diffstat (limited to 'tests/main.test')
| -rw-r--r-- | tests/main.test | 98 |
1 files changed, 69 insertions, 29 deletions
diff --git a/tests/main.test b/tests/main.test index 5eab892..ab66b38 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.18 2006/03/21 11:12:29 dkf Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -18,7 +16,7 @@ namespace eval ::tcl::test::main { # - tests use testing commands introduced in Tcltest 8.4 testConstraint Tcltest [expr { [llength [package provide Tcltest]] - && [package vsatisfies [package provide Tcltest] 8.4]}] + && [package vsatisfies [package provide Tcltest] 8.5-]}] # Procedure to simulate interactive typing of commands, line by line proc type {chan script} { @@ -68,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 { @@ -84,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]} @@ -100,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 { @@ -116,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,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]" @@ -160,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]" @@ -181,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]" @@ -546,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 @@ -555,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 @@ -581,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 @@ -595,19 +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] && [testConstraint unix]} { + if {$wait eq "timeout" && [testConstraint unix]} { exec kill [pid $f] } close $f @@ -620,17 +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] && [testConstraint unix]} { + if {$wait eq "timeout" && [testConstraint unix]} { exec kill [pid $f] } close $f @@ -708,7 +719,7 @@ namespace eval ::tcl::test::main { } -result "Exit MainLoop\nIn exit\neven 0\n" test Tcl_Main-5.9 { - Tcl_Main: interactive mode: delete interp + Tcl_Main: interactive mode: delete interp -> main loop & exit handlers, but no [exit] } -constraints { exec Tcltest @@ -737,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 @@ -798,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 { @@ -958,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] @@ -1181,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 { |