# This file contains a collection of tests for generic/tclMain.c. # # RCS: @(#) $Id: main.test,v 1.1.1.2 2009/03/23 15:10:42 duncan Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." return } 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 # 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 } } cd [temporaryDirectory] # Tests Tcl_Main-1.*: variable initializations test Tcl_Main-1.1 { Tcl_Main: startup script - normal } -constraints { stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script catch {set f [open "|[list [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 { stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} -script catch {set f [open "|[list [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: done by system encoding Note the shortcoming explained in Tcl Feature Request 491789 } -constraints { stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script catch {set f [open "|[list [interpreter] script \u00c0]" r]} } -body { read $f } -cleanup { close $f removeFile script } -result [list script [list [encoding convertfrom [encoding system] \ [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 } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script catch {set f [open "|[list [interpreter] script \u20ac]" r]} } -body { read $f } -cleanup { close $f removeFile script } -result [list script [list [encoding convertfrom [encoding system] \ [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 { makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0 catch {set f [open "|[list [interpreter] \u00c0]" r]} } -body { read $f } -cleanup { close $f removeFile \u00c0 } -result [list [list [encoding convertfrom [encoding system] \ [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 } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac catch {set f [open "|[list [interpreter] \u20ac]" r]} } -body { read $f } -cleanup { close $f removeFile \u20ac } -result [list [list [encoding convertfrom [encoding system] \ [encoding convertto [encoding system] \u20ac]]] {} 0]\n # Tests Tcl_Main-2.*: application-initialization procedure test Tcl_Main-2.1 { Tcl_Main: appInitProc returns error } -constraints { 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 { 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 { 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 { 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 { 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 { exec } -setup { if {[file exists no-such-file]} { error "Can't run test Tcl_Main-3.1\ where a file named \"no-such-file\" exists" } } -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 { 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 { 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 { exec } -setup { makeFile "if 1 \{" script } -body { set code [catch {exec [interpreter] script >& result} result] set f [open result] join [list $code $result [read $f]] \n } -cleanup { close $f file delete result removeFile script } -match glob -result [join [list 1 {child process exited abnormally}\ "missing close-brace\n while executing*"] \n] test Tcl_Main-3.5 { Tcl_Main: startup script sets main loop } -constraints { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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] << {} \ -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.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 test Tcl_Main-5.1 { Tcl_Main: tcl_interactive must be boolean } -constraints { 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 { exec } -setup { catch {set f [open "|[list [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 { exec } -setup { catch {set f [open "|[list [interpreter]]" w+]} catch {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"] 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)]} { exec kill [pid $f] } close $f } -result {child exit} test Tcl_Main-5.4 { Tcl_Main handles stdin EOF in mid-command } -constraints { exec } -setup { set cmd {makeFile "if 1 \{" script} catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]} catch {fconfigure $f -blocking 0} } -body { variable wait fileevent $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)]} { exec kill [pid $f] } close $f removeFile script } -result {child exit} test Tcl_Main-5.5 { Tcl_Main: error raised in interactive mode } -constraints { 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 { 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 { 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 { 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 { 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 { exec Tcltest } -setup { catch {set f [open "|[list [interpreter]]" w+]} catch {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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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% " 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 { Tcl_Main: [exit] defined as no-op -> still have exithandlers } -constraints { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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 { 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" cd [workingDirectory] cleanupTests } namespace delete ::tcl::test::main return