diff options
Diffstat (limited to 'tcl8.6/tests/main.test')
| -rw-r--r-- | tcl8.6/tests/main.test | 1297 |
1 files changed, 1297 insertions, 0 deletions
diff --git a/tcl8.6/tests/main.test b/tcl8.6/tests/main.test new file mode 100644 index 0000000..351fd4f --- /dev/null +++ b/tcl8.6/tests/main.test @@ -0,0 +1,1297 @@ +# This file contains a collection of tests for generic/tclMain.c. + +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::* + + # 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 { + } -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 { + } -constraints { + stdio + } -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 { + } -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 { + } -constraints { + stdio + } -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 + + test Tcl_Main-1.7 { + Tcl_Main: startup script - -encoding option + } -constraints { + stdio + } -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + chan configure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]" + close $f + catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]} + } -body { + read $f + } -cleanup { + close $f + removeFile script + } -result [list script {} 0]\n1\n + + test Tcl_Main-1.8 { + Tcl_Main: startup script - -encoding option - mismatched encodings + } -constraints { + stdio + } -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + chan configure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]" + close $f + catch {set f [open "|[list [interpreter] -encoding ascii script]" r]} + } -body { + read $f + } -cleanup { + close $f + removeFile script + } -result [list script {} 0]\n0\n + + test Tcl_Main-1.9 { + Tcl_Main: startup script - -encoding option - no abbrevation + } -constraints { + stdio + } -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + chan configure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]" + close $f + catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]} + } -body { + type $f { + puts $argv + } + list [catch {gets $f} line] $line + } -cleanup { + close $f + removeFile script + } -result {0 {-enc utf-8 script}} + + # 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 { + chan configure 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 {chan configure $f -blocking 0} + } -body { + type $f "chan configure stdin -eofchar \\032 + if 1 \{\n\032" + variable wait + chan event $f readable \ + [list set [namespace which -variable wait] "child exit"] + set id [after 2000 [list set [namespace which -variable wait] timeout]] + vwait [namespace which -variable wait] + after cancel $id + set wait + } -cleanup { + if {$wait eq "timeout" && [testConstraint unix]} { + 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 {chan configure $f -blocking 0} + } -body { + variable wait + chan event $f readable \ + [list set [namespace which -variable wait] "child exit"] + set id [after 2000 [list set [namespace which -variable wait] timeout]] + vwait [namespace which -variable wait] + after cancel $id + set wait + } -cleanup { + if {$wait eq "timeout" && [testConstraint unix]} { + 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 {chan configure $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" + + test Tcl_Main-5.13 { + Bug 1775878 + } -constraints { + exec + } -setup { + catch {set f [open "|[list [interpreter]]" w+]} + } -body { + type $f "puts \\" + type $f return + list [catch {gets $f} line] $line + } -cleanup { + close $f + } -result [list 0 return] + + # Tests Tcl_Main-6.*: interactive operations with prompts + + test Tcl_Main-6.1 { + 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 + chan configure 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" + + test Tcl_Main-8.13 { + Bug 1775878 + } -constraints { + exec Tcltest + } -setup { + catch {set f [open "|[list [interpreter]]" w+]} + } -body { + exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result + set f [open result] + read $f + } -cleanup { + close $f + file delete result + } -result "pwd\nExit MainLoop\n" + + # Tests Tcl_Main-9.*: Prompt operations + + test Tcl_Main-9.1 { + 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 |