summaryrefslogtreecommitdiffstats
path: root/tests/main.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/main.test')
-rw-r--r--tests/main.test1048
1 files changed, 1048 insertions, 0 deletions
diff --git a/tests/main.test b/tests/main.test
new file mode 100644
index 0000000..62c9631
--- /dev/null
+++ b/tests/main.test
@@ -0,0 +1,1048 @@
+# This file contains a collection of tests for generic/tclMain.c.
+#
+# RCS: @(#) $Id: main.test,v 1.1 2002/01/05 22:55:52 dgp Exp $
+
+if {[catch {package require tcltest 2}]} {
+ puts stderr "Skipping tests in [info script]. tcltest v2 needed."
+ return
+}
+
+namespace eval ::tcl::main::test {
+
+ namespace import ::tcltest::test
+ namespace import ::tcltest::testConstraint
+ namespace import ::tcltest::interpreter
+ namespace import ::tcltest::cleanupTests
+ namespace import ::tcltest::makeFile
+ namespace import ::tcltest::removeFile
+
+ # Is [exec] defined?
+ testConstraint exec [llength [info commands exec]]
+
+ # Is the Tcltest package loaded?
+ # - that is, the special C-coded testing commands in tclTest.c
+ # - tests use testing commands introduced in Tcltest 8.4
+ testConstraint Tcltest [expr {
+ [llength [package provide Tcltest]]
+ && [package vsatisfies [package provide Tcltest] 8.4]}]
+
+ # 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
+ }
+ }
+
+ # Tests Tcl_Main-1.*: variable initializations
+
+ test Tcl_Main-1.1 {
+ Tcl_Main: startup script - normal
+ } -constraints [list exec] -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} script
+ set f [open "|[interpreter] script" r]
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile script
+ } -result [list script {} 0]\n
+
+ test Tcl_Main-1.2 {
+ Tcl_Main: startup script - can't begin with '-'
+ } -constraints [list exec] -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} -script
+ set f [open "|[interpreter] -script" w+]
+ } -body {
+ puts $f {puts [list $argv0 $argv $tcl_interactive]; exit}
+ flush $f
+ read $f
+ } -cleanup {
+ close $f
+ removeFile -script
+ } -result [list [interpreter] -script 0]\n
+
+ test Tcl_Main-1.3 {
+ Tcl_Main: encoding of arguments: system encoding loss
+ } -constraints [list exec] -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} script
+ set f [open "|[interpreter] script \u0098" r]
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile script
+ } -result [list script [list \u0098] 0]\n
+
+ test Tcl_Main-1.4 {
+ Tcl_Main: encoding of arguments: system encoding loss
+ This test fails due to shortcoming noted in Tcl Patch 491789
+ } -constraints [list exec knownBug] -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} script
+ set f [open "|[interpreter] script \u1234" r]
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile script
+ } -result [list script [list \u1234] 0]\n
+
+ test Tcl_Main-1.5 {
+ Tcl_Main: encoding of script name: system encoding loss
+ } -constraints [list exec] -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} \u0098
+ set f [open "|[interpreter] \u0098" r]
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile \u0098
+ } -result [list [list \u0098] {} 0]\n
+
+ test Tcl_Main-1.6 {
+ Tcl_Main: encoding of script name: system encoding loss
+ This test fails due to shortcoming noted in Tcl Patch 491789
+ } -constraints [list exec knownBug] -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} \u1234
+ set f [open "|[interpreter] \u1234" r]
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile \u1234
+ } -result [list [list \u1234] {} 0]\n
+
+ # Tests Tcl_Main-2.*: application-initialization procedure
+
+ test Tcl_Main-2.1 {
+ Tcl_Main: appInitProc returns error
+ } -constraints [list exec Tcltest] -setup {
+ makeFile {puts "In script"} script
+ } -body {
+ exec [interpreter] script -appinitprocerror >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "application-specific initialization failed: \nIn script\n"
+
+ test Tcl_Main-2.2 {
+ Tcl_Main: appInitProc returns error
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {puts "In script"} -appinitprocerror >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "application-specific initialization failed: \nIn script\n"
+
+ test Tcl_Main-2.3 {
+ Tcl_Main: appInitProc deletes interp
+ } -constraints [list exec Tcltest] -setup {
+ makeFile {puts "In script"} script
+ } -body {
+ exec [interpreter] script -appinitprocdeleteinterp >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "application-specific initialization failed: \n"
+
+ test Tcl_Main-2.4 {
+ Tcl_Main: appInitProc deletes interp
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocdeleteinterp >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "application-specific initialization failed: \n"
+
+ test Tcl_Main-2.5 {
+ Tcl_Main: appInitProc closes stderr
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocclosestderr >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "In script\n"
+
+ # Tests Tcl_Main-3.*: startup script evaluation
+
+ test Tcl_Main-3.1 {
+ Tcl_Main: startup script does not exist
+ } -constraints [list exec] -setup {
+ catch {removeFile no-such-file}
+ } -body {
+ set code [catch {exec [interpreter] no-such-file >& result} result]
+ set f [open result]
+ list $code $result [read $f]
+ } -cleanup {
+ close $f
+ file delete result
+ } -match glob -result [list 1 {child process exited abnormally} \
+ {couldn't read file "no-such-file":*}]
+
+ test Tcl_Main-3.2 {
+ Tcl_Main: startup script raises error
+ } -constraints [list exec] -setup {
+ makeFile {error ERROR} script
+ } -body {
+ set code [catch {exec [interpreter] script >& result} result]
+ set f [open result]
+ list $code $result [read $f]
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -match glob -result [list 1 {child process exited abnormally} \
+ "ERROR\n while executing*"]
+
+ test Tcl_Main-3.3 {
+ Tcl_Main: startup script closes stderr
+ } -constraints [list exec] -setup {
+ makeFile {close stderr; error ERROR} script
+ } -body {
+ set code [catch {exec [interpreter] script >& result} result]
+ set f [open result]
+ list $code $result [read $f]
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result [list 1 {child process exited abnormally} {}]
+
+ test Tcl_Main-3.4 {
+ Tcl_Main: startup script holds incomplete script
+ } -constraints [list exec] -setup {
+ makeFile "if 1 \{" script
+ } -body {
+ set code [catch {exec [interpreter] script >& result} result]
+ set f [open result]
+ list $code $result [read $f]
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -match glob -result [list 1 {child process exited abnormally}\
+ "missing close-brace\n while executing*"]
+
+ test Tcl_Main-3.5 {
+ Tcl_Main: startup script sets main loop
+ } -constraints [list exec Tcltest] -setup {
+ makeFile {
+ rename exit _exit
+ proc exit {code} {
+ puts "In exit"
+ _exit $code
+ }
+ after 0 {
+ puts event
+ testexitmainloop
+ }
+ testexithandler create 0
+ testsetmainloop
+ } script
+ } -body {
+ exec [interpreter] script >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "event\nExit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-3.6 {
+ Tcl_Main: startup script sets main loop and closes stdin
+ } -constraints [list exec Tcltest] -setup {
+ makeFile {
+ close stdin
+ testsetmainloop
+ rename exit _exit
+ proc exit {code} {
+ puts "In exit"
+ _exit $code
+ }
+ after 0 {
+ puts event
+ testexitmainloop
+ }
+ testexithandler create 0
+ } script
+ } -body {
+ exec [interpreter] script >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "event\nExit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-3.7 {
+ Tcl_Main: startup script deletes interp
+ } -constraints [list exec Tcltest] -setup {
+ makeFile {
+ rename exit _exit
+ proc exit {code} {
+ puts "In exit"
+ _exit $code
+ }
+ testexithandler create 0
+ testinterpdelete {}
+ } script
+ } -body {
+ exec [interpreter] script >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "even 0\n"
+
+ test Tcl_Main-3.8 {
+ Tcl_Main: startup script deletes interp and sets mainloop
+ } -constraints [list exec Tcltest] -setup {
+ makeFile {
+ testsetmainloop
+ rename exit _exit
+ proc exit {code} {
+ puts "In exit"
+ _exit $code
+ }
+ testexitmainloop
+ testexithandler create 0
+ testinterpdelete {}
+ } script
+ } -body {
+ exec [interpreter] script >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "Exit MainLoop\neven 0\n"
+
+ test Tcl_Main-3.9 {
+ Tcl_Main: startup script can set tcl_interactive without limit
+ } -constraints [list exec] -setup {
+ makeFile {set tcl_interactive foo} script
+ } -body {
+ exec [interpreter] script >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result {}
+
+ # Tests Tcl_Main-4.*: rc file evaluation
+
+ test Tcl_Main-4.1 {
+ Tcl_Main: rcFile evaluation deletes interp
+ } -constraints [list exec Tcltest] -setup {
+ set rc [makeFile {testinterpdelete {}} rc]
+ } -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocsetrcfile $rc >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile rc
+ } -result "application-specific initialization failed: \n"
+
+ test Tcl_Main-4.2 {
+ Tcl_Main: rcFile evaluation closes stdin
+ } -constraints [list exec Tcltest] -setup {
+ set rc [makeFile {close stdin} rc]
+ } -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocsetrcfile $rc >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile rc
+ } -result "application-specific initialization failed: \n"
+
+ test Tcl_Main-4.3 {
+ Tcl_Main: rcFile evaluation closes stdin and sets main loop
+ } -constraints [list exec Tcltest] -setup {
+ set rc [makeFile {
+ close stdin
+ testsetmainloop
+ after 0 testexitmainloop
+ testexithandler create 0
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ } rc]
+ } -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocsetrcfile $rc >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile rc
+ } -result "application-specific initialization failed:\
+ \nExit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-4.4 {
+ Tcl_Main: rcFile evaluation sets main loop
+ } -constraints [list exec Tcltest] -setup {
+ set rc [makeFile {
+ testsetmainloop
+ after 0 testexitmainloop
+ testexithandler create 0
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ } rc]
+ } -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocsetrcfile $rc >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile rc
+ } -result "application-specific initialization failed:\
+ \nIn script\nExit MainLoop\nIn exit\neven 0\n"
+
+ # Tests Tcl_Main-5.*: interactive operations
+
+ test Tcl_Main-5.1 {
+ Tcl_Main: tcl_interactive must be boolean
+ } -constraints [list exec] -body {
+ exec [interpreter] << {set tcl_interactive foo} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "can't set \"tcl_interactive\":\
+ variable must have boolean value\n"
+
+ test Tcl_Main-5.2 {
+ Tcl_Main able to handle non-blocking stdin
+ } -constraints [list exec] -setup {
+ set f [open "|[interpreter]" w+]
+ } -body {
+ type $f {
+ fconfigure stdin -blocking 0
+ puts SUCCESS
+ }
+ list [catch {gets $f} line] $line
+ } -cleanup {
+ close $f
+ } -result [list 0 SUCCESS]
+
+ test Tcl_Main-5.3 {
+ Tcl_Main handles stdin EOF in mid-command
+ } -constraints [list exec] -setup {
+ set f [open "|[interpreter]" w+]
+ fconfigure $f -blocking 0
+ } -body {
+ type $f "fconfigure stdin -eofchar \\032
+ if 1 \{\n\032"
+ variable wait
+ fileevent $f readable \
+ [list set [namespace which -variable wait] "child exit"]
+ after 2000 [list set [namespace which -variable wait] timeout]
+ vwait [namespace which -variable wait]
+ set wait
+ } -cleanup {
+ if {[string equal timeout $wait]
+ && [string equal unix $::tcl_platform(platform)]} {
+ exec kill [pid $f]
+ }
+ close $f
+ } -result {child exit}
+
+ test Tcl_Main-5.4 {
+ Tcl_Main handles stdin EOF in mid-command
+ } -constraints [list exec] -setup {
+ set cmd {makeFile "if 1 \{" script}
+ set f [open "|[interpreter] < [eval $cmd]" r]
+ fconfigure $f -blocking 0
+ } -body {
+ variable wait
+ fileevent $f readable \
+ [list set [namespace which -variable wait] "child exit"]
+ after 2000 [list set [namespace which -variable wait] timeout]
+ vwait [namespace which -variable wait]
+ set wait
+ } -cleanup {
+ if {[string equal timeout $wait]
+ && [string equal unix $::tcl_platform(platform)]} {
+ exec kill [pid $f]
+ }
+ close $f
+ removeFile script
+ } -result {child exit}
+
+ test Tcl_Main-5.5 {
+ Tcl_Main: error raised in interactive mode
+ } -constraints [list exec] -body {
+ exec [interpreter] << {error foo} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "foo\n"
+
+ test Tcl_Main-5.6 {
+ Tcl_Main: interactive mode: errors don't stop command loop
+ } -constraints [list exec] -body {
+ exec [interpreter] << {
+ error foo
+ puts bar
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "foo\nbar\n"
+
+ test Tcl_Main-5.7 {
+ Tcl_Main: interactive mode: closed stderr
+ } -constraints [list exec] -body {
+ exec [interpreter] << {
+ close stderr
+ error foo
+ puts bar
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "bar\n"
+
+ test Tcl_Main-5.8 {
+ Tcl_Main: interactive mode: close stdin
+ -> main loop & [exit] & exit handlers
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ testsetmainloop
+ testexitmainloop
+ testexithandler create 0
+ close stdin
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-5.9 {
+ Tcl_Main: interactive mode: delete interp
+ -> main loop & exit handlers, but no [exit]
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ testsetmainloop
+ testexitmainloop
+ testexithandler create 0
+ testinterpdelete {}
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\neven 0\n"
+
+ test Tcl_Main-5.10 {
+ Tcl_Main: exit main loop in mid-interactive command
+ } -constraints [list exec Tcltest] -setup {
+ set f [open "|[interpreter]" w+]
+ fconfigure $f -blocking 0
+ } -body {
+ type $f "testsetmainloop
+ after 2000 testexitmainloop
+ puts \{1 2"
+ after 4000
+ type $f "3 4\}"
+ set code1 [catch {gets $f} line1]
+ set code2 [catch {gets $f} line2]
+ set code3 [catch {gets $f} line3]
+ list $code1 $line1 $code2 $line2 $code3 $line3
+ } -cleanup {
+ close $f
+ } -result [list 0 {Exit MainLoop} 0 {1 2} 0 {3 4}]
+
+ test Tcl_Main-5.11 {
+ Tcl_Main: EOF in interactive main loop
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ testexithandler create 0
+ after 0 testexitmainloop
+ testsetmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-5.12 {
+ Tcl_Main: close stdin in interactive main loop
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ testexithandler create 0
+ after 100 testexitmainloop
+ testsetmainloop
+ close stdin
+ puts "don't reach this"
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+ # Tests Tcl_Main-6.*: interactive operations with prompts
+
+ test Tcl_Main-6.1 {
+ Tcl_Main: enable prompts with tcl_interactive
+ } -constraints [list exec] -body {
+ exec [interpreter] << {set tcl_interactive 1} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% "
+
+ test Tcl_Main-6.2 {
+ Tcl_Main: prompt deletes interp
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {testinterpdelete {}}
+ set tcl_interactive 1
+ puts "not reached"
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n"
+
+ test Tcl_Main-6.3 {
+ Tcl_Main: prompt closes stdin
+ } -constraints [list exec] -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {close stdin}
+ set tcl_interactive 1
+ puts "not reached"
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n"
+
+ test Tcl_Main-6.4 {
+ Tcl_Main: interactive output, closed stdout
+ } -constraints [list exec] -body {
+ exec [interpreter] << {
+ set tcl_interactive 1
+ close stdout
+ set a NO
+ puts stderr YES
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% YES\n"
+
+ test Tcl_Main-6.5 {
+ Tcl_Main: interactive entry to main loop
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ set tcl_interactive 1
+ testsetmainloop
+ testexitmainloop} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% % % Exit MainLoop\n"
+
+ test Tcl_Main-6.6 {
+ Tcl_Main: number of prompts during stdin close exit
+ } -constraints [list exec] -body {
+ exec [interpreter] << {
+ set tcl_interactive 1
+ close stdin} >& 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 {
+ Tcl_Main: [exit] defined as no-op -> still have exithandlers
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ proc exit args {}
+ testexithandler create 0
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "even 0\n"
+
+ test Tcl_Main-7.2 {
+ Tcl_Main: [exit] defined as no-op -> still have exithandlers
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ proc exit args {}
+ testexithandler create 0
+ after 0 testexitmainloop
+ testsetmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\neven 0\n"
+
+ # Tests Tcl_Main-8.*: StdinProc operations
+
+ test Tcl_Main-8.1 {
+ StdinProc: handles non-blocking stdin
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ fconfigure stdin -blocking 0
+ testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\n"
+
+ test Tcl_Main-8.2 {
+ StdinProc: handles stdin EOF
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ testexithandler create 0
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ after 100 testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-8.3 {
+ StdinProc: handles interactive stdin EOF
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ testexithandler create 0
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ set tcl_interactive 1} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% even 0\n"
+
+ test Tcl_Main-8.4 {
+ StdinProc: handles stdin close
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ after 100 testexitmainloop
+ after 0 puts 1
+ close stdin
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\nExit MainLoop\nIn exit\n"
+
+ test Tcl_Main-8.5 {
+ StdinProc: handles interactive stdin close
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ set tcl_interactive 1
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ after 100 testexitmainloop
+ after 0 puts 1
+ close stdin
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% % % after#0\n% after#1\n% 1\nExit MainLoop\nIn exit\n"
+
+ test Tcl_Main-8.6 {
+ StdinProc: handles event loop re-entry
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ after 100 {puts 1; set delay 1}
+ vwait delay
+ puts 2
+ testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n2\nExit MainLoop\n"
+
+ test Tcl_Main-8.7 {
+ StdinProc: handling of errors
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ error foo
+ testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "foo\nExit MainLoop\n"
+
+ test Tcl_Main-8.8 {
+ StdinProc: handling of errors, closed stderr
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ close stderr
+ error foo
+ testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\n"
+
+ test Tcl_Main-8.9 {
+ StdinProc: interactive output
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ set tcl_interactive 1
+ testexitmainloop} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% % Exit MainLoop\n"
+
+ test Tcl_Main-8.10 {
+ StdinProc: interactive output, closed stdout
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ close stdout
+ set tcl_interactive 1
+ testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result {}
+
+ test Tcl_Main-8.11 {
+ StdinProc: prompt deletes interp
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ set tcl_prompt1 {testinterpdelete {}}
+ set tcl_interactive 1} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n"
+
+ test Tcl_Main-8.12 {
+ StdinProc: prompt closes stdin
+ } -constraints [list exec Tcltest] -body {
+ exec [interpreter] << {
+ testsetmainloop
+ set tcl_prompt1 {close stdin}
+ after 100 testexitmainloop
+ set tcl_interactive 1
+ puts "not reached"
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\nExit MainLoop\n"
+
+ # Tests Tcl_Main-9.*: Prompt operations
+
+ test Tcl_Main-9.1 {
+ Prompt: custom prompt variables
+ } -constraints [list exec] -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {puts -nonewline stdout "one "}
+ set tcl_prompt2 {puts -nonewline stdout "two "}
+ set tcl_interactive 1
+ puts {This is
+ a test}} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\none two This is\n\t\ta test\none "
+
+ test Tcl_Main-9.2 {
+ Prompt: error in custom prompt variables
+ } -constraints [list exec] -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {error foo}
+ set tcl_interactive 1
+ set errorInfo} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\nfoo\n% foo\n while executing\n\"error foo\"\n (script\
+ that generates prompt)\nfoo\n% "
+
+ test Tcl_Main-9.3 {
+ Prompt: error in custom prompt variables, closed stderr
+ } -constraints [list exec] -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {close stderr; error foo}
+ set tcl_interactive 1} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% "
+
+ test Tcl_Main-9.4 {
+ Prompt: error in custom prompt variables, closed stdout
+ } -constraints [list exec] -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {close stdout; error foo}
+ set tcl_interactive 1} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\nfoo\n"
+
+ cleanupTests
+}
+
+namespace delete ::tcl::main::test
+