summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-05-31 14:20:29 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-05-31 14:20:29 (GMT)
commit88726e934130098aa10cde9b33859d45a8c87bdd (patch)
tree52388390d8d47f3a79a5e04aa70eb1bd90d5f50b
parent39cdbfc5a3ed76e69a755678d17c8c64ee7ac886 (diff)
downloadtcl-88726e934130098aa10cde9b33859d45a8c87bdd.zip
tcl-88726e934130098aa10cde9b33859d45a8c87bdd.tar.gz
tcl-88726e934130098aa10cde9b33859d45a8c87bdd.tar.bz2
fix subtle problem with safe [file] that caused Tk test failure
-rw-r--r--ChangeLog4
-rw-r--r--library/safe.tcl18
2 files changed, 15 insertions, 7 deletions
diff --git a/ChangeLog b/ChangeLog
index 22fe1f3..81bf5e9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2012-05-31 Donal K. Fellows <dkf@users.sf.net>
+ * library/safe.tcl (safe::AliasFileSubcommand): Don't assume that
+ slaves have corresponding commands, as that is not true for
+ sub-subinterpreters (used in Tk's test suite).
+
* doc/safe.n: [Bug 1997845]: Corrected formatting so that generated
HTML can link properly.
diff --git a/library/safe.tcl b/library/safe.tcl
index 4ad5c36..394aa97 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -494,16 +494,16 @@ proc ::safe::InterpInit {
if {[catch {::interp eval $slave {
source [file join $tcl_library init.tcl]
- }} msg]} {
+ }} msg opt]} {
Log $slave "can't source init.tcl ($msg)"
- return -code error "can't source init.tcl into slave $slave ($msg)"
+ return -options $opt "can't source init.tcl into slave $slave ($msg)"
}
if {[catch {::interp eval $slave {
source [file join $tcl_library tm.tcl]
- }} msg]} {
+ }} msg opt]} {
Log $slave "can't source tm.tcl ($msg)"
- return -code error "can't source tm.tcl into slave $slave ($msg)"
+ return -options $opt "can't source tm.tcl into slave $slave ($msg)"
}
# Sync the paths used to search for Tcl modules. This can be done only
@@ -684,7 +684,7 @@ proc ::safe::AliasFileSubcommand {slave subcommand name} {
if {[string match ~* $name]} {
set name ./$name
}
- tailcall $slave invokehidden tcl:file:$subcommand $name
+ tailcall ::interp invokehidden $slave tcl:file:$subcommand $name
}
# AliasGlob is the target of the "glob" alias in safe interpreters.
@@ -882,6 +882,7 @@ proc ::safe::AliasSource {slave args} {
# because we want to control [info script] in the slave so information
# doesn't leak so much. [Bug 2913625]
set old [::interp eval $slave {info script}]
+ set replacementMsg "script error"
set code [catch {
set f [open $realfile]
fconfigure $f -eofchar \032
@@ -891,14 +892,17 @@ proc ::safe::AliasSource {slave args} {
set contents [read $f]
close $f
::interp eval $slave [list info script $file]
- ::interp eval $slave $contents
} msg opt]
+ if {$code == 0} {
+ set code [catch {::interp eval $slave $contents} msg opt]
+ set replacementMsg $msg
+ }
catch {interp eval $slave [list info script $old]}
# Note that all non-errors are fine result codes from [source], so we must
# take a little care to do it properly. [Bug 2923613]
if {$code == 1} {
Log $slave $msg
- return -code error "script error"
+ return -code error $replacementMsg
}
return -code $code -options $opt $msg
}