* doc/Tcl_Main.3:

        * generic/tclMain.c:  Substantial rewrite and expanded documentation
        of Tcl_Main to correct a number of bugs and flaws:

                * Interactive Tcl_Main can now enter a main loop, exit
                  that loop and continue interactive operations.  The loop
                  may even exit in the midst of interactive command typing
                  without loss of the partial command.  [Bugs 486453, 474131]
                * Tcl_Main now gracefully handles deletion of its master
                  interpreter.
                * Interactive Tcl_Main can now operate with non-blocking stdin
                * Interactive Tcl_Main can now detect EOF on stdin even in
                  mid-command.  [Bug 491341]
                * Added VFS-aware internal routines for managing the
                  startup script selection.
                * Tcl variable 'tcl_interactive' is now linked to C variable
                  'tty' so that one can disable/enable interactive prompts
                  at the script level when there is no startup script.  This
                  is meant for use by the test suite.
                * Consistent use of the Tcl libraries standard channels as
                  returned by Tcl_GetStdChannel(); as opposed to the channels
                  named 'stdin', 'stdout', and 'stderr' in the master interp,
                  which can be different or unavailable.
                * Tcl_Main now calls Tcl_Exit() if evaluation of [exit] in the
                  master interpreter returns, assuring Tcl_Main does not return.                * Documented Tcl_Main's absence from public stub table
                * Documented that Tcl_Main does not return.
                * Documented Tcl variables set by Tcl_Main.
                * All prompts are done from a single procedure, Prompt.
                * Use of Tcl_Obj-enabled interfaces everywhere.

        * generic/tclInt.decls (TclGetStartupScriptPath,
          TclSetStartupScriptPath): New internal VFS-aware routines for
        managing the startup script of Tcl_Main.
        * generic/tclIntDecls.h:
        * generic/tclStubInit.c: make genstubs

        * generic/tclTest.c (TestsetmainloopCmd,TestexitmainloopCmd,
          Tcltest_Init,TestinterpdeleteCmd):
        * tests/main.test (new):  Added new file to test suite that
        thoroughly tests generic/tclMain.c; added some new test commands
        for testing Tcl_SetMainLoop().

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
+