summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclInterp.c19
-rw-r--r--tests/interp.test72
-rw-r--r--tests/safe.test6
4 files changed, 73 insertions, 29 deletions
diff --git a/ChangeLog b/ChangeLog
index c0c590e..28c3a18 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2009-12-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInterp.c (Tcl_MakeSafe): [Bug 2895741]: Make sure that
+ the min() and max() functions are supported in safe interpreters.
+
2009-12-28 Donal K. Fellows <dkf@users.sf.net>
* unix/configure.in: [Bug 942170]: Detect the st_blocks field of
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 6ff8cea..e7ad80d 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.83.2.3 2009/12/28 10:05:22 dkf Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.83.2.4 2009/12/29 13:13:18 dkf Exp $
*/
#include "tclInt.h"
@@ -2817,9 +2817,26 @@ Tcl_MakeSafe(
{
Tcl_Channel chan; /* Channel to remove from safe interpreter. */
Interp *iPtr = (Interp *) interp;
+ Tcl_Interp *master = ((InterpInfo*) iPtr->interpInfo)->slave.masterInterp;
TclHideUnsafeCommands(interp);
+ if (master != NULL) {
+ /*
+ * Alias these function implementations in the slave to those in the
+ * master; the overall implementations are safe, but they're normally
+ * defined by init.tcl which is not sourced by safe interpreters.
+ * Assume these functions all work. [Bug 2895741]
+ */
+
+ (void) Tcl_Eval(interp,
+ "namespace eval ::tcl {namespace eval mathfunc {}}");
+ (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
+ "::tcl::mathfunc::min", 0, NULL);
+ (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
+ "::tcl::mathfunc::max", 0, NULL);
+ }
+
iPtr->flags |= SAFE_INTERP;
/*
diff --git a/tests/interp.test b/tests/interp.test
index 62a45dc..3a0c6a5 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: interp.test,v 1.54.2.2 2009/12/28 10:05:22 dkf Exp $
+# RCS: @(#) $Id: interp.test,v 1.54.2.3 2009/12/29 13:13:18 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -433,74 +433,83 @@ test interp-11.7 {testing interp target} {
test interp-12.1 {testing interp issafe} {
interp issafe
} 0
-test interp-12.2 {testing interp issafe} {
+test interp-12.2 {testing interp issafe} -setup {
catch {interp delete a}
+} -body {
interp create a
interp issafe a
-} 0
-test interp-12.3 {testing interp issafe} {
+} -result 0
+test interp-12.3 {testing interp issafe} -setup {
catch {interp delete a}
+} -body {
interp create a
interp create {a x3} -safe
interp issafe {a x3}
-} 1
-test interp-12.4 {testing interp issafe} {
+} -result 1
+test interp-12.4 {testing interp issafe} -setup {
catch {interp delete a}
+} -body {
interp create a
interp create {a x3} -safe
interp create {a x3 foo}
interp issafe {a x3 foo}
-} 1
+} -result 1
# Part 12: testing interpreter object command "issafe" sub-command
-test interp-13.1 {testing foo issafe} {
+test interp-13.1 {testing foo issafe} -setup {
catch {interp delete a}
+} -body {
interp create a
a issafe
-} 0
-test interp-13.2 {testing foo issafe} {
+} -result 0
+test interp-13.2 {testing foo issafe} -setup {
catch {interp delete a}
+} -body {
interp create a
interp create {a x3} -safe
a eval x3 issafe
-} 1
-test interp-13.3 {testing foo issafe} {
+} -result 1
+test interp-13.3 {testing foo issafe} -setup {
catch {interp delete a}
+} -body {
interp create a
interp create {a x3} -safe
interp create {a x3 foo}
a eval x3 eval foo issafe
-} 1
-test interp-13.4 {testing issafe arg checking} {
+} -result 1
+test interp-13.4 {testing issafe arg checking} -body {
catch {interp create a}
- list [catch {a issafe too many args} msg] $msg
-} {1 {wrong # args: should be "a issafe"}}
+ a issafe too many args
+} -returnCodes error -result {wrong # args: should be "a issafe"}
# part 14: testing interp aliases
test interp-14.1 {testing interp aliases} {
interp aliases
} ""
-test interp-14.2 {testing interp aliases} {
+test interp-14.2 {testing interp aliases} -setup {
catch {interp delete a}
+} -body {
interp create a
a alias a1 puts
a alias a2 puts
a alias a3 puts
lsort [interp aliases a]
-} {a1 a2 a3}
-test interp-14.3 {testing interp aliases} {
+} -result {a1 a2 a3}
+test interp-14.3 {testing interp aliases} -setup {
catch {interp delete a}
+} -body {
interp create a
interp create {a x3}
interp alias {a x3} froboz "" puts
interp aliases {a x3}
-} froboz
-test interp-14.4 {testing interp alias - alias over master} {
- # SF Bug 641195
+} -result froboz
+test interp-14.4 {testing interp alias - alias over master} -setup {
catch {interp delete a}
+} -body {
+ # SF Bug 641195
interp create a
list [catch {interp alias "" a a eval} msg] $msg [info commands a]
-} {1 {cannot define or rename alias "a": interpreter deleted} {}}
+} -result {1 {cannot define or rename alias "a": interpreter deleted} {}}
test interp-14.5 {testing interp-alias: wrong # args} -body {
proc setx x {set x}
interp alias {} a {} setx
@@ -1791,11 +1800,11 @@ test interp-23.2 {testing hiding vs aliases} {unixOrPc} {
lappend l [lsort [interp aliases a]]
lappend l [lsort [interp hidden a]]
a alias bar {}
- lappend l [interp aliases a]
+ lappend l [lsort [interp aliases a]]
lappend l [lsort [interp hidden a]]
interp delete a
set l
-} {{cd encoding exec exit fconfigure file glob load open pwd socket source unload} {bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload} {bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source unload} clock {cd encoding exec exit fconfigure file glob load open pwd socket source unload}}
+} {{cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload}}
test interp-24.1 {result resetting on error} {
catch {interp delete a}
@@ -3481,6 +3490,19 @@ test interp-36.7 {SlaveBgerror sets error handler of slave [1999035]} -setup {
interp delete slave
} -result foo
+test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup {
+ catch {interp delete a}
+ interp create a
+ set result {}
+} -body {
+ interp create {a b} -safe
+ lappend result [interp eval a {expr min(5,2,3)*max(7,13,11)}]
+ lappend result [interp eval {a b} {expr min(5,2,3)*max(7,13,11)}]
+} -cleanup {
+ unset result
+ interp delete a
+} -result {26 26}
+
# cleanup
foreach i [interp slaves] {
interp delete $i
diff --git a/tests/safe.test b/tests/safe.test
index ed92aba..e4e3596 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: safe.test,v 1.22.4.5 2009/12/28 13:48:51 dkf Exp $
+# RCS: @(#) $Id: safe.test,v 1.22.4.6 2009/12/29 13:13:18 dkf Exp $
package require Tcl 8.5
@@ -72,8 +72,8 @@ test safe-2.3 {creating safe interpreters, should have no unexpected aliases} {
interp create a -safe
set l [a aliases]
interp delete a
- set l
-} {clock}
+ lsort $l
+} {::tcl::mathfunc::max ::tcl::mathfunc::min clock}
test safe-3.1 {calling safe::interpInit is safe} {
catch {safe::interpDelete a}