diff options
Diffstat (limited to 'tcl8.6/tests/main.test')
| -rw-r--r-- | tcl8.6/tests/main.test | 1297 |
1 files changed, 0 insertions, 1297 deletions
diff --git a/tcl8.6/tests/main.test b/tcl8.6/tests/main.test deleted file mode 100644 index 351fd4f..0000000 --- a/tcl8.6/tests/main.test +++ /dev/null @@ -1,1297 +0,0 @@ -# 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 |