Import Tcl 8.6.10

This commit is contained in:
Steve Dower
2020-09-24 22:53:56 +01:00
parent 0343d03b22
commit 3bb8e3e086
1005 changed files with 593700 additions and 41637 deletions

View File

@@ -21,10 +21,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests
# Custom constraints used in this file
testConstraint fcopy [llength [info commands fcopy]]
testConstraint testchannel [llength [info commands testchannel]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
#----------------------------------------------------------------------
@@ -282,7 +282,7 @@ removeFile fconfigure.dummy
test iocmd-8.14 {fconfigure command} {
fconfigure stdin -buffers
} 4096
test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrPc} -setup {
test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup {
set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $srv -sockname] 2]
proc iocmdSRV {sock ip port} {close $sock}
@@ -384,19 +384,18 @@ test iocmd-10.5 {fblocked command} {
set path(test4) [makeFile {} test4]
set path(test5) [makeFile {} test5]
file delete $path(test5)
test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
test iocmd-11.1 {I/O to command pipelines} {unixOrWin unixExecs} {
set f [open $path(test4) w]
close $f
list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
} {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
test iocmd-11.2 {I/O to command pipelines} {unixOrWin unixExecs} {
list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
test iocmd-11.3 {I/O to command pipelines} {unixOrWin unixExecs} {
list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.4 {I/O to command pipelines} unixOrPc {
test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrWin} {
list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
} {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}
@@ -807,11 +806,11 @@ test iocmd-21.20 {Bug 88aef05cda} -setup {
}
set ch [chan create {read write} foo]
} -body {
list [catch {chan configure $ch -blocking 0} m] $m
chan configure $ch -blocking 0
} -cleanup {
close $ch
rename foo {}
} -match glob -result {1 {*nested eval*}}
} -match glob -returnCodes 1 -result {*(infinite loop?)*}
test iocmd-21.21 {[close] in [read] segfaults} -setup {
proc foo {method chan args} {
switch -- $method initialize {
@@ -1986,7 +1985,7 @@ test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body {
proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
note [fileevent $c readable {note TOCK}]
set stop [after 10000 {note TIMEOUT}]
set stop [after 15000 {note TIMEOUT}]
after 1000 {note [chan postevent $c r]}
vwait ::res
catch {after cancel $stop}
@@ -1999,7 +1998,7 @@ test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
note [fileevent $c writable {note TOCK}]
set stop [after 10000 {note TIMEOUT}]
set stop [after 15000 {note TIMEOUT}]
after 1000 {note [chan postevent $c w]}
vwait ::res
catch {after cancel $stop}
@@ -2058,6 +2057,8 @@ test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body {
lappend res [catch {interp eval $idb [list close $chan]} msg] $msg
set res
} -cleanup {
interp delete $idb
} -constraints {testchannel} \
-result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
@@ -2100,6 +2101,8 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
set res
}]
set res
} -cleanup {
interp delete $idb
} -constraints {testchannel} -result {Owner lost}
test iocmd-32.2 {delete interp of reflected chan} {
@@ -3778,7 +3781,6 @@ test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {
# Use constraints to skip this test while valgrinding so this expected leak
# doesn't prevent a finding of "leak-free".
#
testConstraint notValgrind [expr {![testConstraint valgrind]}]
test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body {
#puts <<$tcltest::mainThread>>main
@@ -3831,13 +3833,21 @@ test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -mat
rename track {}
# cleanup
# Eliminate valgrind "still reachable" reports on outstanding "Detached"
# structures in the detached list which stem from PipeClose2Proc not waiting
# around for background processes to complete, meaning that previous calls to
# Tcl_ReapDetachedProcs might not have had a chance to reap all processes.
after 10
exec [info nameofexecutable] << {}
foreach file [list test1 test2 test3 test4] {
removeFile $file
}
# delay long enough for background processes to finish
after 500
foreach file [list test5] {
removeFile $file
}
removeFile test5
cleanupTests
return