通讯编程

开发平台：
Visual C++

main.test：源码内容
							# 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."
    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 scriptn"
    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 scriptn"
    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 scriptn"
    # 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} 
	"ERRORn    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-bracen    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 "eventnExit MainLoopnIn exitneven 0n"
    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 "eventnExit MainLoopnIn exitneven 0n"
    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 0n"
    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 MainLoopneven 0n"
    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 MainLoopnIn exitneven 0n"
    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 MainLoopnIn exitneven 0n"
    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 callbacknInteractive outputn"
    # 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 valuen"
    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 {n32"
	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 "foon"
    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 "foonbarn"
    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 "barn"
    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 MainLoopnIn exitneven 0n"
    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 MainLoopneven 0n"
    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 MainLoopnIn exitneven 0n"
    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 MainLoopnIn exitneven 0n"
    # 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 "1n% "
    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 "1n"
    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 "1n"
    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 "1n% YESn"
    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 "1n% % % Exit MainLoopn"
    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 "1n% "
    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 "1n% % "
    # 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 0n"
    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 MainLoopneven 0n"
    # 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 MainLoopn"
    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 MainLoopnIn exitneven 0n"
    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 "1n% even 0n"
    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 "1nExit MainLoopnIn exitn"
    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 "1n% % % after#0n% after#1n% 1nExit MainLoopnIn exitn"
    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 "1n2nExit MainLoopn"
    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 "foonExit MainLoopn"
    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 MainLoopn"
    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 "1n% % Exit MainLoopn"
    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 "1n"
    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 "1nExit MainLoopn"
    # 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 "1none two This isntta testnone "
    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 "1nfoon% foon    while executingn"error foo"n    (script
	that generates prompt)nfoon% "
    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 "1n% "
    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 "1nfoon"
    cd [workingDirectory]
    cleanupTests
}
namespace delete ::tcl::test::main
return

						