1296 lines
28 KiB
Plaintext
1296 lines
28 KiB
Plaintext
|
# 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 5000 [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 5000 [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
|
||
|
|
} -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
|