os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/main.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/main.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,1222 @@
1.4 +# This file contains a collection of tests for generic/tclMain.c.
1.5 +#
1.6 +# RCS: @(#) $Id$
1.7 +
1.8 +if {[catch {package require tcltest 2.0.2}]} {
1.9 + puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
1.10 + return
1.11 +}
1.12 +
1.13 +namespace eval ::tcl::test::main {
1.14 +
1.15 + namespace import ::tcltest::test
1.16 + namespace import ::tcltest::testConstraint
1.17 + namespace import ::tcltest::interpreter
1.18 + namespace import ::tcltest::cleanupTests
1.19 + namespace import ::tcltest::makeFile
1.20 + namespace import ::tcltest::removeFile
1.21 + namespace import ::tcltest::temporaryDirectory
1.22 + namespace import ::tcltest::workingDirectory
1.23 +
1.24 + # Is [exec] defined?
1.25 + testConstraint exec [llength [info commands exec]]
1.26 +
1.27 + # Is the Tcltest package loaded?
1.28 + # - that is, the special C-coded testing commands in tclTest.c
1.29 + # - tests use testing commands introduced in Tcltest 8.4
1.30 + testConstraint Tcltest [expr {
1.31 + [llength [package provide Tcltest]]
1.32 + && [package vsatisfies [package provide Tcltest] 8.4]}]
1.33 +
1.34 + # Procedure to simulate interactive typing of commands, line by line
1.35 + proc type {chan script} {
1.36 + foreach line [split $script \n] {
1.37 + if {[catch {
1.38 + puts $chan $line
1.39 + flush $chan
1.40 + }]} {
1.41 + return
1.42 + }
1.43 + # Grrr... Behavior depends on this value.
1.44 + after 1000
1.45 + }
1.46 + }
1.47 +
1.48 + cd [temporaryDirectory]
1.49 + # Tests Tcl_Main-1.*: variable initializations
1.50 +
1.51 + test Tcl_Main-1.1 {
1.52 + Tcl_Main: startup script - normal
1.53 + } -constraints {
1.54 + stdio
1.55 + } -setup {
1.56 + makeFile {puts [list $argv0 $argv $tcl_interactive]} script
1.57 + catch {set f [open "|[list [interpreter] script]" r]}
1.58 + } -body {
1.59 + read $f
1.60 + } -cleanup {
1.61 + close $f
1.62 + removeFile script
1.63 + } -result [list script {} 0]\n
1.64 +
1.65 + test Tcl_Main-1.2 {
1.66 + Tcl_Main: startup script - can't begin with '-'
1.67 + } -constraints {
1.68 + stdio
1.69 + } -setup {
1.70 + makeFile {puts [list $argv0 $argv $tcl_interactive]} -script
1.71 + catch {set f [open "|[list [interpreter] -script]" w+]}
1.72 + } -body {
1.73 + puts $f {puts [list $argv0 $argv $tcl_interactive]; exit}
1.74 + flush $f
1.75 + read $f
1.76 + } -cleanup {
1.77 + close $f
1.78 + removeFile -script
1.79 + } -result [list [interpreter] -script 0]\n
1.80 +
1.81 + test Tcl_Main-1.3 {
1.82 + Tcl_Main: encoding of arguments: done by system encoding
1.83 + Note the shortcoming explained in Tcl Feature Request 491789
1.84 + } -constraints {
1.85 + stdio
1.86 + } -setup {
1.87 + makeFile {puts [list $argv0 $argv $tcl_interactive]} script
1.88 + catch {set f [open "|[list [interpreter] script \u00c0]" r]}
1.89 + } -body {
1.90 + read $f
1.91 + } -cleanup {
1.92 + close $f
1.93 + removeFile script
1.94 + } -result [list script [list [encoding convertfrom [encoding system] \
1.95 + [encoding convertto [encoding system] \u00c0]]] 0]\n
1.96 +
1.97 + test Tcl_Main-1.4 {
1.98 + Tcl_Main: encoding of arguments: done by system encoding
1.99 + Note the shortcoming explained in Tcl Feature Request 491789
1.100 + } -constraints {
1.101 + stdio tempNotWin
1.102 + } -setup {
1.103 + makeFile {puts [list $argv0 $argv $tcl_interactive]} script
1.104 + catch {set f [open "|[list [interpreter] script \u20ac]" r]}
1.105 + } -body {
1.106 + read $f
1.107 + } -cleanup {
1.108 + close $f
1.109 + removeFile script
1.110 + } -result [list script [list [encoding convertfrom [encoding system] \
1.111 + [encoding convertto [encoding system] \u20ac]]] 0]\n
1.112 +
1.113 + test Tcl_Main-1.5 {
1.114 + Tcl_Main: encoding of script name: system encoding loss
1.115 + Note the shortcoming explained in Tcl Feature Request 491789
1.116 + } -constraints {
1.117 + stdio
1.118 + } -setup {
1.119 + makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0
1.120 + catch {set f [open "|[list [interpreter] \u00c0]" r]}
1.121 + } -body {
1.122 + read $f
1.123 + } -cleanup {
1.124 + close $f
1.125 + removeFile \u00c0
1.126 + } -result [list [list [encoding convertfrom [encoding system] \
1.127 + [encoding convertto [encoding system] \u00c0]]] {} 0]\n
1.128 +
1.129 + test Tcl_Main-1.6 {
1.130 + Tcl_Main: encoding of script name: system encoding loss
1.131 + Note the shortcoming explained in Tcl Feature Request 491789
1.132 + } -constraints {
1.133 + stdio tempNotWin
1.134 + } -setup {
1.135 + makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac
1.136 + catch {set f [open "|[list [interpreter] \u20ac]" r]}
1.137 + } -body {
1.138 + read $f
1.139 + } -cleanup {
1.140 + close $f
1.141 + removeFile \u20ac
1.142 + } -result [list [list [encoding convertfrom [encoding system] \
1.143 + [encoding convertto [encoding system] \u20ac]]] {} 0]\n
1.144 +
1.145 + # Tests Tcl_Main-2.*: application-initialization procedure
1.146 +
1.147 + test Tcl_Main-2.1 {
1.148 + Tcl_Main: appInitProc returns error
1.149 + } -constraints {
1.150 + exec Tcltest
1.151 + } -setup {
1.152 + makeFile {puts "In script"} script
1.153 + } -body {
1.154 + exec [interpreter] script -appinitprocerror >& result
1.155 + set f [open result]
1.156 + read $f
1.157 + } -cleanup {
1.158 + close $f
1.159 + file delete result
1.160 + removeFile script
1.161 + } -result "application-specific initialization failed: \nIn script\n"
1.162 +
1.163 + test Tcl_Main-2.2 {
1.164 + Tcl_Main: appInitProc returns error
1.165 + } -constraints {
1.166 + exec Tcltest
1.167 + } -body {
1.168 + exec [interpreter] << {puts "In script"} -appinitprocerror >& result
1.169 + set f [open result]
1.170 + read $f
1.171 + } -cleanup {
1.172 + close $f
1.173 + file delete result
1.174 + } -result "application-specific initialization failed: \nIn script\n"
1.175 +
1.176 + test Tcl_Main-2.3 {
1.177 + Tcl_Main: appInitProc deletes interp
1.178 + } -constraints {
1.179 + exec Tcltest
1.180 + } -setup {
1.181 + makeFile {puts "In script"} script
1.182 + } -body {
1.183 + exec [interpreter] script -appinitprocdeleteinterp >& result
1.184 + set f [open result]
1.185 + read $f
1.186 + } -cleanup {
1.187 + close $f
1.188 + file delete result
1.189 + removeFile script
1.190 + } -result "application-specific initialization failed: \n"
1.191 +
1.192 + test Tcl_Main-2.4 {
1.193 + Tcl_Main: appInitProc deletes interp
1.194 + } -constraints {
1.195 + exec Tcltest
1.196 + } -body {
1.197 + exec [interpreter] << {puts "In script"} \
1.198 + -appinitprocdeleteinterp >& result
1.199 + set f [open result]
1.200 + read $f
1.201 + } -cleanup {
1.202 + close $f
1.203 + file delete result
1.204 + } -result "application-specific initialization failed: \n"
1.205 +
1.206 + test Tcl_Main-2.5 {
1.207 + Tcl_Main: appInitProc closes stderr
1.208 + } -constraints {
1.209 + exec Tcltest
1.210 + } -body {
1.211 + exec [interpreter] << {puts "In script"} \
1.212 + -appinitprocclosestderr >& result
1.213 + set f [open result]
1.214 + read $f
1.215 + } -cleanup {
1.216 + close $f
1.217 + file delete result
1.218 + } -result "In script\n"
1.219 +
1.220 + # Tests Tcl_Main-3.*: startup script evaluation
1.221 +
1.222 + test Tcl_Main-3.1 {
1.223 + Tcl_Main: startup script does not exist
1.224 + } -constraints {
1.225 + exec
1.226 + } -setup {
1.227 + if {[file exists no-such-file]} {
1.228 + error "Can't run test Tcl_Main-3.1\
1.229 + where a file named \"no-such-file\" exists"
1.230 + }
1.231 + } -body {
1.232 + set code [catch {exec [interpreter] no-such-file >& result} result]
1.233 + set f [open result]
1.234 + list $code $result [read $f]
1.235 + } -cleanup {
1.236 + close $f
1.237 + file delete result
1.238 + } -match glob -result [list 1 {child process exited abnormally} \
1.239 + {couldn't read file "no-such-file":*}]
1.240 +
1.241 + test Tcl_Main-3.2 {
1.242 + Tcl_Main: startup script raises error
1.243 + } -constraints {
1.244 + exec
1.245 + } -setup {
1.246 + makeFile {error ERROR} script
1.247 + } -body {
1.248 + set code [catch {exec [interpreter] script >& result} result]
1.249 + set f [open result]
1.250 + list $code $result [read $f]
1.251 + } -cleanup {
1.252 + close $f
1.253 + file delete result
1.254 + removeFile script
1.255 + } -match glob -result [list 1 {child process exited abnormally} \
1.256 + "ERROR\n while executing*"]
1.257 +
1.258 + test Tcl_Main-3.3 {
1.259 + Tcl_Main: startup script closes stderr
1.260 + } -constraints {
1.261 + exec
1.262 + } -setup {
1.263 + makeFile {close stderr; error ERROR} script
1.264 + } -body {
1.265 + set code [catch {exec [interpreter] script >& result} result]
1.266 + set f [open result]
1.267 + list $code $result [read $f]
1.268 + } -cleanup {
1.269 + close $f
1.270 + file delete result
1.271 + removeFile script
1.272 + } -result [list 1 {child process exited abnormally} {}]
1.273 +
1.274 + test Tcl_Main-3.4 {
1.275 + Tcl_Main: startup script holds incomplete script
1.276 + } -constraints {
1.277 + exec
1.278 + } -setup {
1.279 + makeFile "if 1 \{" script
1.280 + } -body {
1.281 + set code [catch {exec [interpreter] script >& result} result]
1.282 + set f [open result]
1.283 + join [list $code $result [read $f]] \n
1.284 + } -cleanup {
1.285 + close $f
1.286 + file delete result
1.287 + removeFile script
1.288 + } -match glob -result [join [list 1 {child process exited abnormally}\
1.289 + "missing close-brace\n while executing*"] \n]
1.290 +
1.291 + test Tcl_Main-3.5 {
1.292 + Tcl_Main: startup script sets main loop
1.293 + } -constraints {
1.294 + exec Tcltest
1.295 + } -setup {
1.296 + makeFile {
1.297 + rename exit _exit
1.298 + proc exit {code} {
1.299 + puts "In exit"
1.300 + _exit $code
1.301 + }
1.302 + after 0 {
1.303 + puts event
1.304 + testexitmainloop
1.305 + }
1.306 + testexithandler create 0
1.307 + testsetmainloop
1.308 + } script
1.309 + } -body {
1.310 + exec [interpreter] script >& result
1.311 + set f [open result]
1.312 + read $f
1.313 + } -cleanup {
1.314 + close $f
1.315 + file delete result
1.316 + removeFile script
1.317 + } -result "event\nExit MainLoop\nIn exit\neven 0\n"
1.318 +
1.319 + test Tcl_Main-3.6 {
1.320 + Tcl_Main: startup script sets main loop and closes stdin
1.321 + } -constraints {
1.322 + exec Tcltest
1.323 + } -setup {
1.324 + makeFile {
1.325 + close stdin
1.326 + testsetmainloop
1.327 + rename exit _exit
1.328 + proc exit {code} {
1.329 + puts "In exit"
1.330 + _exit $code
1.331 + }
1.332 + after 0 {
1.333 + puts event
1.334 + testexitmainloop
1.335 + }
1.336 + testexithandler create 0
1.337 + } script
1.338 + } -body {
1.339 + exec [interpreter] script >& result
1.340 + set f [open result]
1.341 + read $f
1.342 + } -cleanup {
1.343 + close $f
1.344 + file delete result
1.345 + removeFile script
1.346 + } -result "event\nExit MainLoop\nIn exit\neven 0\n"
1.347 +
1.348 + test Tcl_Main-3.7 {
1.349 + Tcl_Main: startup script deletes interp
1.350 + } -constraints {
1.351 + exec Tcltest
1.352 + } -setup {
1.353 + makeFile {
1.354 + rename exit _exit
1.355 + proc exit {code} {
1.356 + puts "In exit"
1.357 + _exit $code
1.358 + }
1.359 + testexithandler create 0
1.360 + testinterpdelete {}
1.361 + } script
1.362 + } -body {
1.363 + exec [interpreter] script >& result
1.364 + set f [open result]
1.365 + read $f
1.366 + } -cleanup {
1.367 + close $f
1.368 + file delete result
1.369 + removeFile script
1.370 + } -result "even 0\n"
1.371 +
1.372 + test Tcl_Main-3.8 {
1.373 + Tcl_Main: startup script deletes interp and sets mainloop
1.374 + } -constraints {
1.375 + exec Tcltest
1.376 + } -setup {
1.377 + makeFile {
1.378 + testsetmainloop
1.379 + rename exit _exit
1.380 + proc exit {code} {
1.381 + puts "In exit"
1.382 + _exit $code
1.383 + }
1.384 + testexitmainloop
1.385 + testexithandler create 0
1.386 + testinterpdelete {}
1.387 + } script
1.388 + } -body {
1.389 + exec [interpreter] script >& result
1.390 + set f [open result]
1.391 + read $f
1.392 + } -cleanup {
1.393 + close $f
1.394 + file delete result
1.395 + removeFile script
1.396 + } -result "Exit MainLoop\neven 0\n"
1.397 +
1.398 + test Tcl_Main-3.9 {
1.399 + Tcl_Main: startup script can set tcl_interactive without limit
1.400 + } -constraints {
1.401 + exec
1.402 + } -setup {
1.403 + makeFile {set tcl_interactive foo} script
1.404 + } -body {
1.405 + exec [interpreter] script >& result
1.406 + set f [open result]
1.407 + read $f
1.408 + } -cleanup {
1.409 + close $f
1.410 + file delete result
1.411 + removeFile script
1.412 + } -result {}
1.413 +
1.414 + # Tests Tcl_Main-4.*: rc file evaluation
1.415 +
1.416 + test Tcl_Main-4.1 {
1.417 + Tcl_Main: rcFile evaluation deletes interp
1.418 + } -constraints {
1.419 + exec Tcltest
1.420 + } -setup {
1.421 + set rc [makeFile {testinterpdelete {}} rc]
1.422 + } -body {
1.423 + exec [interpreter] << {puts "In script"} \
1.424 + -appinitprocsetrcfile $rc >& result
1.425 + set f [open result]
1.426 + read $f
1.427 + } -cleanup {
1.428 + close $f
1.429 + file delete result
1.430 + removeFile rc
1.431 + } -result "application-specific initialization failed: \n"
1.432 +
1.433 + test Tcl_Main-4.2 {
1.434 + Tcl_Main: rcFile evaluation closes stdin
1.435 + } -constraints {
1.436 + exec Tcltest
1.437 + } -setup {
1.438 + set rc [makeFile {close stdin} rc]
1.439 + } -body {
1.440 + exec [interpreter] << {puts "In script"} \
1.441 + -appinitprocsetrcfile $rc >& result
1.442 + set f [open result]
1.443 + read $f
1.444 + } -cleanup {
1.445 + close $f
1.446 + file delete result
1.447 + removeFile rc
1.448 + } -result "application-specific initialization failed: \n"
1.449 +
1.450 + test Tcl_Main-4.3 {
1.451 + Tcl_Main: rcFile evaluation closes stdin and sets main loop
1.452 + } -constraints {
1.453 + exec Tcltest
1.454 + } -setup {
1.455 + set rc [makeFile {
1.456 + close stdin
1.457 + testsetmainloop
1.458 + after 0 testexitmainloop
1.459 + testexithandler create 0
1.460 + rename exit _exit
1.461 + proc exit code {
1.462 + puts "In exit"
1.463 + _exit $code
1.464 + }
1.465 + } rc]
1.466 + } -body {
1.467 + exec [interpreter] << {puts "In script"} \
1.468 + -appinitprocsetrcfile $rc >& result
1.469 + set f [open result]
1.470 + read $f
1.471 + } -cleanup {
1.472 + close $f
1.473 + file delete result
1.474 + removeFile rc
1.475 + } -result "application-specific initialization failed:\
1.476 + \nExit MainLoop\nIn exit\neven 0\n"
1.477 +
1.478 + test Tcl_Main-4.4 {
1.479 + Tcl_Main: rcFile evaluation sets main loop
1.480 + } -constraints {
1.481 + exec Tcltest
1.482 + } -setup {
1.483 + set rc [makeFile {
1.484 + testsetmainloop
1.485 + after 0 testexitmainloop
1.486 + testexithandler create 0
1.487 + rename exit _exit
1.488 + proc exit code {
1.489 + puts "In exit"
1.490 + _exit $code
1.491 + }
1.492 + } rc]
1.493 + } -body {
1.494 + exec [interpreter] << {} \
1.495 + -appinitprocsetrcfile $rc >& result
1.496 + set f [open result]
1.497 + read $f
1.498 + } -cleanup {
1.499 + close $f
1.500 + file delete result
1.501 + removeFile rc
1.502 + } -result "application-specific initialization failed:\
1.503 + \nExit MainLoop\nIn exit\neven 0\n"
1.504 +
1.505 + test Tcl_Main-4.5 {
1.506 + Tcl_Main: Bug 1481986
1.507 + } -constraints {
1.508 + exec Tcltest
1.509 + } -setup {
1.510 + set rc [makeFile {
1.511 + testsetmainloop
1.512 + after 0 {puts "Event callback"}
1.513 + } rc]
1.514 + } -body {
1.515 + set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+]
1.516 + after 1000
1.517 + type $f {puts {Interactive output}
1.518 + exit
1.519 + }
1.520 + read $f
1.521 + } -cleanup {
1.522 + catch {close $f}
1.523 + removeFile rc
1.524 + } -result "Event callback\nInteractive output\n"
1.525 +
1.526 + # Tests Tcl_Main-5.*: interactive operations
1.527 +
1.528 + test Tcl_Main-5.1 {
1.529 + Tcl_Main: tcl_interactive must be boolean
1.530 + } -constraints {
1.531 + exec
1.532 + } -body {
1.533 + exec [interpreter] << {set tcl_interactive foo} >& result
1.534 + set f [open result]
1.535 + read $f
1.536 + } -cleanup {
1.537 + close $f
1.538 + file delete result
1.539 + } -result "can't set \"tcl_interactive\":\
1.540 + variable must have boolean value\n"
1.541 +
1.542 + test Tcl_Main-5.2 {
1.543 + Tcl_Main able to handle non-blocking stdin
1.544 + } -constraints {
1.545 + exec
1.546 + } -setup {
1.547 + catch {set f [open "|[list [interpreter]]" w+]}
1.548 + } -body {
1.549 + type $f {
1.550 + fconfigure stdin -blocking 0
1.551 + puts SUCCESS
1.552 + }
1.553 + list [catch {gets $f} line] $line
1.554 + } -cleanup {
1.555 + close $f
1.556 + } -result [list 0 SUCCESS]
1.557 +
1.558 + test Tcl_Main-5.3 {
1.559 + Tcl_Main handles stdin EOF in mid-command
1.560 + } -constraints {
1.561 + exec
1.562 + } -setup {
1.563 + catch {set f [open "|[list [interpreter]]" w+]}
1.564 + catch {fconfigure $f -blocking 0}
1.565 + } -body {
1.566 + type $f "fconfigure stdin -eofchar \\032
1.567 + if 1 \{\n\032"
1.568 + variable wait
1.569 + fileevent $f readable \
1.570 + [list set [namespace which -variable wait] "child exit"]
1.571 + set id [after 2000 [list set [namespace which -variable wait] timeout]]
1.572 + vwait [namespace which -variable wait]
1.573 + after cancel $id
1.574 + set wait
1.575 + } -cleanup {
1.576 + if {[string equal timeout $wait]
1.577 + && [string equal unix $::tcl_platform(platform)]} {
1.578 + exec kill [pid $f]
1.579 + }
1.580 + close $f
1.581 + } -result {child exit}
1.582 +
1.583 + test Tcl_Main-5.4 {
1.584 + Tcl_Main handles stdin EOF in mid-command
1.585 + } -constraints {
1.586 + exec
1.587 + } -setup {
1.588 + set cmd {makeFile "if 1 \{" script}
1.589 + catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]}
1.590 + catch {fconfigure $f -blocking 0}
1.591 + } -body {
1.592 + variable wait
1.593 + fileevent $f readable \
1.594 + [list set [namespace which -variable wait] "child exit"]
1.595 + set id [after 2000 [list set [namespace which -variable wait] timeout]]
1.596 + vwait [namespace which -variable wait]
1.597 + after cancel $id
1.598 + set wait
1.599 + } -cleanup {
1.600 + if {[string equal timeout $wait]
1.601 + && [string equal unix $::tcl_platform(platform)]} {
1.602 + exec kill [pid $f]
1.603 + }
1.604 + close $f
1.605 + removeFile script
1.606 + } -result {child exit}
1.607 +
1.608 + test Tcl_Main-5.5 {
1.609 + Tcl_Main: error raised in interactive mode
1.610 + } -constraints {
1.611 + exec
1.612 + } -body {
1.613 + exec [interpreter] << {error foo} >& result
1.614 + set f [open result]
1.615 + read $f
1.616 + } -cleanup {
1.617 + close $f
1.618 + file delete result
1.619 + } -result "foo\n"
1.620 +
1.621 + test Tcl_Main-5.6 {
1.622 + Tcl_Main: interactive mode: errors don't stop command loop
1.623 + } -constraints {
1.624 + exec
1.625 + } -body {
1.626 + exec [interpreter] << {
1.627 + error foo
1.628 + puts bar
1.629 + } >& result
1.630 + set f [open result]
1.631 + read $f
1.632 + } -cleanup {
1.633 + close $f
1.634 + file delete result
1.635 + } -result "foo\nbar\n"
1.636 +
1.637 + test Tcl_Main-5.7 {
1.638 + Tcl_Main: interactive mode: closed stderr
1.639 + } -constraints {
1.640 + exec
1.641 + } -body {
1.642 + exec [interpreter] << {
1.643 + close stderr
1.644 + error foo
1.645 + puts bar
1.646 + } >& result
1.647 + set f [open result]
1.648 + read $f
1.649 + } -cleanup {
1.650 + close $f
1.651 + file delete result
1.652 + } -result "bar\n"
1.653 +
1.654 + test Tcl_Main-5.8 {
1.655 + Tcl_Main: interactive mode: close stdin
1.656 + -> main loop & [exit] & exit handlers
1.657 + } -constraints {
1.658 + exec Tcltest
1.659 + } -body {
1.660 + exec [interpreter] << {
1.661 + rename exit _exit
1.662 + proc exit code {
1.663 + puts "In exit"
1.664 + _exit $code
1.665 + }
1.666 + testsetmainloop
1.667 + testexitmainloop
1.668 + testexithandler create 0
1.669 + close stdin
1.670 + } >& result
1.671 + set f [open result]
1.672 + read $f
1.673 + } -cleanup {
1.674 + close $f
1.675 + file delete result
1.676 + } -result "Exit MainLoop\nIn exit\neven 0\n"
1.677 +
1.678 + test Tcl_Main-5.9 {
1.679 + Tcl_Main: interactive mode: delete interp
1.680 + -> main loop & exit handlers, but no [exit]
1.681 + } -constraints {
1.682 + exec Tcltest
1.683 + } -body {
1.684 + exec [interpreter] << {
1.685 + rename exit _exit
1.686 + proc exit code {
1.687 + puts "In exit"
1.688 + _exit $code
1.689 + }
1.690 + testsetmainloop
1.691 + testexitmainloop
1.692 + testexithandler create 0
1.693 + testinterpdelete {}
1.694 + } >& result
1.695 + set f [open result]
1.696 + read $f
1.697 + } -cleanup {
1.698 + close $f
1.699 + file delete result
1.700 + } -result "Exit MainLoop\neven 0\n"
1.701 +
1.702 + test Tcl_Main-5.10 {
1.703 + Tcl_Main: exit main loop in mid-interactive command
1.704 + } -constraints {
1.705 + exec Tcltest
1.706 + } -setup {
1.707 + catch {set f [open "|[list [interpreter]]" w+]}
1.708 + catch {fconfigure $f -blocking 0}
1.709 + } -body {
1.710 + type $f "testsetmainloop
1.711 + after 2000 testexitmainloop
1.712 + puts \{1 2"
1.713 + after 4000
1.714 + type $f "3 4\}"
1.715 + set code1 [catch {gets $f} line1]
1.716 + set code2 [catch {gets $f} line2]
1.717 + set code3 [catch {gets $f} line3]
1.718 + list $code1 $line1 $code2 $line2 $code3 $line3
1.719 + } -cleanup {
1.720 + close $f
1.721 + } -result [list 0 {Exit MainLoop} 0 {1 2} 0 {3 4}]
1.722 +
1.723 + test Tcl_Main-5.11 {
1.724 + Tcl_Main: EOF in interactive main loop
1.725 + } -constraints {
1.726 + exec Tcltest
1.727 + } -body {
1.728 + exec [interpreter] << {
1.729 + rename exit _exit
1.730 + proc exit code {
1.731 + puts "In exit"
1.732 + _exit $code
1.733 + }
1.734 + testexithandler create 0
1.735 + after 0 testexitmainloop
1.736 + testsetmainloop
1.737 + } >& result
1.738 + set f [open result]
1.739 + read $f
1.740 + } -cleanup {
1.741 + close $f
1.742 + file delete result
1.743 + } -result "Exit MainLoop\nIn exit\neven 0\n"
1.744 +
1.745 + test Tcl_Main-5.12 {
1.746 + Tcl_Main: close stdin in interactive main loop
1.747 + } -constraints {
1.748 + exec Tcltest
1.749 + } -body {
1.750 + exec [interpreter] << {
1.751 + rename exit _exit
1.752 + proc exit code {
1.753 + puts "In exit"
1.754 + _exit $code
1.755 + }
1.756 + testexithandler create 0
1.757 + after 100 testexitmainloop
1.758 + testsetmainloop
1.759 + close stdin
1.760 + puts "don't reach this"
1.761 + } >& result
1.762 + set f [open result]
1.763 + read $f
1.764 + } -cleanup {
1.765 + close $f
1.766 + file delete result
1.767 + } -result "Exit MainLoop\nIn exit\neven 0\n"
1.768 +
1.769 + # Tests Tcl_Main-6.*: interactive operations with prompts
1.770 +
1.771 + test Tcl_Main-6.1 {
1.772 + Tcl_Main: enable prompts with tcl_interactive
1.773 + } -constraints {
1.774 + exec
1.775 + } -body {
1.776 + exec [interpreter] << {set tcl_interactive 1} >& result
1.777 + set f [open result]
1.778 + read $f
1.779 + } -cleanup {
1.780 + close $f
1.781 + file delete result
1.782 + } -result "1\n% "
1.783 +
1.784 + test Tcl_Main-6.2 {
1.785 + Tcl_Main: prompt deletes interp
1.786 + } -constraints {
1.787 + exec Tcltest
1.788 + } -body {
1.789 + exec [interpreter] << {
1.790 + set tcl_prompt1 {testinterpdelete {}}
1.791 + set tcl_interactive 1
1.792 + puts "not reached"
1.793 + } >& result
1.794 + set f [open result]
1.795 + read $f
1.796 + } -cleanup {
1.797 + close $f
1.798 + file delete result
1.799 + } -result "1\n"
1.800 +
1.801 + test Tcl_Main-6.3 {
1.802 + Tcl_Main: prompt closes stdin
1.803 + } -constraints {
1.804 + exec
1.805 + } -body {
1.806 + exec [interpreter] << {
1.807 + set tcl_prompt1 {close stdin}
1.808 + set tcl_interactive 1
1.809 + puts "not reached"
1.810 + } >& result
1.811 + set f [open result]
1.812 + read $f
1.813 + } -cleanup {
1.814 + close $f
1.815 + file delete result
1.816 + } -result "1\n"
1.817 +
1.818 + test Tcl_Main-6.4 {
1.819 + Tcl_Main: interactive output, closed stdout
1.820 + } -constraints {
1.821 + exec
1.822 + } -body {
1.823 + exec [interpreter] << {
1.824 + set tcl_interactive 1
1.825 + close stdout
1.826 + set a NO
1.827 + puts stderr YES
1.828 + } >& result
1.829 + set f [open result]
1.830 + read $f
1.831 + } -cleanup {
1.832 + close $f
1.833 + file delete result
1.834 + } -result "1\n% YES\n"
1.835 +
1.836 + test Tcl_Main-6.5 {
1.837 + Tcl_Main: interactive entry to main loop
1.838 + } -constraints {
1.839 + exec Tcltest
1.840 + } -body {
1.841 + exec [interpreter] << {
1.842 + set tcl_interactive 1
1.843 + testsetmainloop
1.844 + testexitmainloop} >& result
1.845 + set f [open result]
1.846 + read $f
1.847 + } -cleanup {
1.848 + close $f
1.849 + file delete result
1.850 + } -result "1\n% % % Exit MainLoop\n"
1.851 +
1.852 + test Tcl_Main-6.6 {
1.853 + Tcl_Main: number of prompts during stdin close exit
1.854 + } -constraints {
1.855 + exec
1.856 + } -body {
1.857 + exec [interpreter] << {
1.858 + set tcl_interactive 1
1.859 + close stdin} >& result
1.860 + set f [open result]
1.861 + read $f
1.862 + } -cleanup {
1.863 + close $f
1.864 + file delete result
1.865 + } -result "1\n% "
1.866 +
1.867 + test Tcl_Main-6.7 {
1.868 + [unknown]: interactive auto-completion.
1.869 + } -constraints {
1.870 + exec
1.871 + } -body {
1.872 + exec [interpreter] << {
1.873 + proc foo\{ x {}
1.874 + set ::auto_noexec xxx
1.875 + set tcl_interactive 1
1.876 + foo y} >& result
1.877 + set f [open result]
1.878 + read $f
1.879 + } -cleanup {
1.880 + close $f
1.881 + file delete result
1.882 + } -result "1\n% % "
1.883 +
1.884 + # Tests Tcl_Main-7.*: exiting
1.885 +
1.886 + test Tcl_Main-7.1 {
1.887 + Tcl_Main: [exit] defined as no-op -> still have exithandlers
1.888 + } -constraints {
1.889 + exec Tcltest
1.890 + } -body {
1.891 + exec [interpreter] << {
1.892 + proc exit args {}
1.893 + testexithandler create 0
1.894 + } >& result
1.895 + set f [open result]
1.896 + read $f
1.897 + } -cleanup {
1.898 + close $f
1.899 + file delete result
1.900 + } -result "even 0\n"
1.901 +
1.902 + test Tcl_Main-7.2 {
1.903 + Tcl_Main: [exit] defined as no-op -> still have exithandlers
1.904 + } -constraints {
1.905 + exec Tcltest
1.906 + } -body {
1.907 + exec [interpreter] << {
1.908 + proc exit args {}
1.909 + testexithandler create 0
1.910 + after 0 testexitmainloop
1.911 + testsetmainloop
1.912 + } >& result
1.913 + set f [open result]
1.914 + read $f
1.915 + } -cleanup {
1.916 + close $f
1.917 + file delete result
1.918 + } -result "Exit MainLoop\neven 0\n"
1.919 +
1.920 + # Tests Tcl_Main-8.*: StdinProc operations
1.921 +
1.922 + test Tcl_Main-8.1 {
1.923 + StdinProc: handles non-blocking stdin
1.924 + } -constraints {
1.925 + exec Tcltest
1.926 + } -body {
1.927 + exec [interpreter] << {
1.928 + testsetmainloop
1.929 + fconfigure stdin -blocking 0
1.930 + testexitmainloop
1.931 + } >& result
1.932 + set f [open result]
1.933 + read $f
1.934 + } -cleanup {
1.935 + close $f
1.936 + file delete result
1.937 + } -result "Exit MainLoop\n"
1.938 +
1.939 + test Tcl_Main-8.2 {
1.940 + StdinProc: handles stdin EOF
1.941 + } -constraints {
1.942 + exec Tcltest
1.943 + } -body {
1.944 + exec [interpreter] << {
1.945 + testsetmainloop
1.946 + testexithandler create 0
1.947 + rename exit _exit
1.948 + proc exit code {
1.949 + puts "In exit"
1.950 + _exit $code
1.951 + }
1.952 + after 100 testexitmainloop
1.953 + } >& result
1.954 + set f [open result]
1.955 + read $f
1.956 + } -cleanup {
1.957 + close $f
1.958 + file delete result
1.959 + } -result "Exit MainLoop\nIn exit\neven 0\n"
1.960 +
1.961 + test Tcl_Main-8.3 {
1.962 + StdinProc: handles interactive stdin EOF
1.963 + } -constraints {
1.964 + exec Tcltest
1.965 + } -body {
1.966 + exec [interpreter] << {
1.967 + testsetmainloop
1.968 + testexithandler create 0
1.969 + rename exit _exit
1.970 + proc exit code {
1.971 + puts "In exit"
1.972 + _exit $code
1.973 + }
1.974 + set tcl_interactive 1} >& result
1.975 + set f [open result]
1.976 + read $f
1.977 + } -cleanup {
1.978 + close $f
1.979 + file delete result
1.980 + } -result "1\n% even 0\n"
1.981 +
1.982 + test Tcl_Main-8.4 {
1.983 + StdinProc: handles stdin close
1.984 + } -constraints {
1.985 + exec Tcltest
1.986 + } -body {
1.987 + exec [interpreter] << {
1.988 + testsetmainloop
1.989 + rename exit _exit
1.990 + proc exit code {
1.991 + puts "In exit"
1.992 + _exit $code
1.993 + }
1.994 + after 100 testexitmainloop
1.995 + after 0 puts 1
1.996 + close stdin
1.997 + } >& result
1.998 + set f [open result]
1.999 + read $f
1.1000 + } -cleanup {
1.1001 + close $f
1.1002 + file delete result
1.1003 + } -result "1\nExit MainLoop\nIn exit\n"
1.1004 +
1.1005 + test Tcl_Main-8.5 {
1.1006 + StdinProc: handles interactive stdin close
1.1007 + } -constraints {
1.1008 + exec Tcltest
1.1009 + } -body {
1.1010 + exec [interpreter] << {
1.1011 + testsetmainloop
1.1012 + set tcl_interactive 1
1.1013 + rename exit _exit
1.1014 + proc exit code {
1.1015 + puts "In exit"
1.1016 + _exit $code
1.1017 + }
1.1018 + after 100 testexitmainloop
1.1019 + after 0 puts 1
1.1020 + close stdin
1.1021 + } >& result
1.1022 + set f [open result]
1.1023 + read $f
1.1024 + } -cleanup {
1.1025 + close $f
1.1026 + file delete result
1.1027 + } -result "1\n% % % after#0\n% after#1\n% 1\nExit MainLoop\nIn exit\n"
1.1028 +
1.1029 + test Tcl_Main-8.6 {
1.1030 + StdinProc: handles event loop re-entry
1.1031 + } -constraints {
1.1032 + exec Tcltest
1.1033 + } -body {
1.1034 + exec [interpreter] << {
1.1035 + testsetmainloop
1.1036 + after 100 {puts 1; set delay 1}
1.1037 + vwait delay
1.1038 + puts 2
1.1039 + testexitmainloop
1.1040 + } >& result
1.1041 + set f [open result]
1.1042 + read $f
1.1043 + } -cleanup {
1.1044 + close $f
1.1045 + file delete result
1.1046 + } -result "1\n2\nExit MainLoop\n"
1.1047 +
1.1048 + test Tcl_Main-8.7 {
1.1049 + StdinProc: handling of errors
1.1050 + } -constraints {
1.1051 + exec Tcltest
1.1052 + } -body {
1.1053 + exec [interpreter] << {
1.1054 + testsetmainloop
1.1055 + error foo
1.1056 + testexitmainloop
1.1057 + } >& result
1.1058 + set f [open result]
1.1059 + read $f
1.1060 + } -cleanup {
1.1061 + close $f
1.1062 + file delete result
1.1063 + } -result "foo\nExit MainLoop\n"
1.1064 +
1.1065 + test Tcl_Main-8.8 {
1.1066 + StdinProc: handling of errors, closed stderr
1.1067 + } -constraints {
1.1068 + exec Tcltest
1.1069 + } -body {
1.1070 + exec [interpreter] << {
1.1071 + testsetmainloop
1.1072 + close stderr
1.1073 + error foo
1.1074 + testexitmainloop
1.1075 + } >& result
1.1076 + set f [open result]
1.1077 + read $f
1.1078 + } -cleanup {
1.1079 + close $f
1.1080 + file delete result
1.1081 + } -result "Exit MainLoop\n"
1.1082 +
1.1083 + test Tcl_Main-8.9 {
1.1084 + StdinProc: interactive output
1.1085 + } -constraints {
1.1086 + exec Tcltest
1.1087 + } -body {
1.1088 + exec [interpreter] << {
1.1089 + testsetmainloop
1.1090 + set tcl_interactive 1
1.1091 + testexitmainloop} >& result
1.1092 + set f [open result]
1.1093 + read $f
1.1094 + } -cleanup {
1.1095 + close $f
1.1096 + file delete result
1.1097 + } -result "1\n% % Exit MainLoop\n"
1.1098 +
1.1099 + test Tcl_Main-8.10 {
1.1100 + StdinProc: interactive output, closed stdout
1.1101 + } -constraints {
1.1102 + exec Tcltest
1.1103 + } -body {
1.1104 + exec [interpreter] << {
1.1105 + testsetmainloop
1.1106 + close stdout
1.1107 + set tcl_interactive 1
1.1108 + testexitmainloop
1.1109 + } >& result
1.1110 + set f [open result]
1.1111 + read $f
1.1112 + } -cleanup {
1.1113 + close $f
1.1114 + file delete result
1.1115 + } -result {}
1.1116 +
1.1117 + test Tcl_Main-8.11 {
1.1118 + StdinProc: prompt deletes interp
1.1119 + } -constraints {
1.1120 + exec Tcltest
1.1121 + } -body {
1.1122 + exec [interpreter] << {
1.1123 + testsetmainloop
1.1124 + set tcl_prompt1 {testinterpdelete {}}
1.1125 + set tcl_interactive 1} >& result
1.1126 + set f [open result]
1.1127 + read $f
1.1128 + } -cleanup {
1.1129 + close $f
1.1130 + file delete result
1.1131 + } -result "1\n"
1.1132 +
1.1133 + test Tcl_Main-8.12 {
1.1134 + StdinProc: prompt closes stdin
1.1135 + } -constraints {
1.1136 + exec Tcltest
1.1137 + } -body {
1.1138 + exec [interpreter] << {
1.1139 + testsetmainloop
1.1140 + set tcl_prompt1 {close stdin}
1.1141 + after 100 testexitmainloop
1.1142 + set tcl_interactive 1
1.1143 + puts "not reached"
1.1144 + } >& result
1.1145 + set f [open result]
1.1146 + read $f
1.1147 + } -cleanup {
1.1148 + close $f
1.1149 + file delete result
1.1150 + } -result "1\nExit MainLoop\n"
1.1151 +
1.1152 + # Tests Tcl_Main-9.*: Prompt operations
1.1153 +
1.1154 + test Tcl_Main-9.1 {
1.1155 + Prompt: custom prompt variables
1.1156 + } -constraints {
1.1157 + exec
1.1158 + } -body {
1.1159 + exec [interpreter] << {
1.1160 + set tcl_prompt1 {puts -nonewline stdout "one "}
1.1161 + set tcl_prompt2 {puts -nonewline stdout "two "}
1.1162 + set tcl_interactive 1
1.1163 + puts {This is
1.1164 + a test}} >& result
1.1165 + set f [open result]
1.1166 + read $f
1.1167 + } -cleanup {
1.1168 + close $f
1.1169 + file delete result
1.1170 + } -result "1\none two This is\n\t\ta test\none "
1.1171 +
1.1172 + test Tcl_Main-9.2 {
1.1173 + Prompt: error in custom prompt variables
1.1174 + } -constraints {
1.1175 + exec
1.1176 + } -body {
1.1177 + exec [interpreter] << {
1.1178 + set tcl_prompt1 {error foo}
1.1179 + set tcl_interactive 1
1.1180 + set errorInfo} >& result
1.1181 + set f [open result]
1.1182 + read $f
1.1183 + } -cleanup {
1.1184 + close $f
1.1185 + file delete result
1.1186 + } -result "1\nfoo\n% foo\n while executing\n\"error foo\"\n (script\
1.1187 + that generates prompt)\nfoo\n% "
1.1188 +
1.1189 + test Tcl_Main-9.3 {
1.1190 + Prompt: error in custom prompt variables, closed stderr
1.1191 + } -constraints {
1.1192 + exec
1.1193 + } -body {
1.1194 + exec [interpreter] << {
1.1195 + set tcl_prompt1 {close stderr; error foo}
1.1196 + set tcl_interactive 1} >& result
1.1197 + set f [open result]
1.1198 + read $f
1.1199 + } -cleanup {
1.1200 + close $f
1.1201 + file delete result
1.1202 + } -result "1\n% "
1.1203 +
1.1204 + test Tcl_Main-9.4 {
1.1205 + Prompt: error in custom prompt variables, closed stdout
1.1206 + } -constraints {
1.1207 + exec
1.1208 + } -body {
1.1209 + exec [interpreter] << {
1.1210 + set tcl_prompt1 {close stdout; error foo}
1.1211 + set tcl_interactive 1} >& result
1.1212 + set f [open result]
1.1213 + read $f
1.1214 + } -cleanup {
1.1215 + close $f
1.1216 + file delete result
1.1217 + } -result "1\nfoo\n"
1.1218 +
1.1219 + cd [workingDirectory]
1.1220 +
1.1221 + cleanupTests
1.1222 +}
1.1223 +
1.1224 +namespace delete ::tcl::test::main
1.1225 +return