summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-06-16 17:20:06 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-06-16 17:20:06 (GMT)
commit0f82494d95766fca811ff7df84d03b1949f2afa1 (patch)
treeb6126422cb910158f02508f907fc4a3380dfd5a3 /tests
parentd893a31f9f960d1906332988842de1b8bd0c4f5c (diff)
parentbccf168ae55a2c314248ee8e3a2369efba47f317 (diff)
downloadtcl-0f82494d95766fca811ff7df84d03b1949f2afa1.zip
tcl-0f82494d95766fca811ff7df84d03b1949f2afa1.tar.gz
tcl-0f82494d95766fca811ff7df84d03b1949f2afa1.tar.bz2
merge trunk
Diffstat (limited to 'tests')
-rw-r--r--tests/fCmd.test13
-rw-r--r--tests/proc.test9
-rw-r--r--tests/safe.test14
3 files changed, 30 insertions, 6 deletions
diff --git a/tests/fCmd.test b/tests/fCmd.test
index f2adcef..72b7da9 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -39,6 +39,7 @@ if {[testConstraint win]} {
}
}
+set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
testConstraint foundGroup [expr {![testConstraint unix]}]
@@ -591,7 +592,7 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
[subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
createfile tf1
file rename tf1 $tmpspace
glob -nocomplain tf* [file join $tmpspace tf1]
@@ -610,21 +611,21 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
} -result {d:/tcl8975@}
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup {
cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
file mkdir td1
file rename td1 $tmpspace
glob -nocomplain td* [file join $tmpspace td*]
} -result [file join $tmpspace td1]
test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup {
cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
createfile tf1
file rename tf1 $tmpspace
glob -nocomplain tf* [file join $tmpspace tf*]
} -result [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
cleanup $tmpspace
-} -constraints {notRoot xdev} -body {
+} -constraints {xdev notRoot} -body {
file mkdir td1/td2/td3
file attributes td1 -permissions 0000
file rename td1 $tmpspace
@@ -693,7 +694,7 @@ test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
file mkdir foo/bar
file attr foo -perm 040555
file rename foo/bar $tmpspace
@@ -1353,7 +1354,7 @@ test fCmd-12.8 {renamefile: generic error} -setup {
} -result {1}
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
set s [createfile tfa]
file rename tfa $tmpspace
list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
diff --git a/tests/proc.test b/tests/proc.test
index ed3c4b6..e06720e 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -374,6 +374,15 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} -body {
} -cleanup {
namespace delete ugly
} -result 4
+
+test proc-7.4 {Proc struct outlives its interp: Bug 3532959} {
+ set lambda x
+ lappend lambda {set a 1}
+ interp create slave
+ slave eval [list apply $lambda foo]
+ interp delete slave
+ unset lambda
+} {}
# cleanup
catch {rename p ""}
diff --git a/tests/safe.test b/tests/safe.test
index dcd5bfd..4a2792e 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -334,6 +334,20 @@ test safe-8.9 {safe source and return} -setup {
catch {safe::interpDelete $i}
removeFile $returnScript
} -result ok
+test safe-8.10 {safe source and return} -setup {
+ set returnScript [makeFile {return -level 2 "ok"} return.tcl]
+ catch {safe::interpDelete $i}
+} -body {
+ safe::interpCreate $i
+ set token [safe::interpAddToAccessPath $i [file dirname $returnScript]]
+ $i eval [list apply {filename {
+ source $filename
+ error boom
+ }} $token/[file tail $returnScript]]
+} -cleanup {
+ catch {safe::interpDelete $i}
+ removeFile $returnScript
+} -result ok
test safe-9.1 {safe interps' deleteHook} -setup {
set i "a"