[Bug 2895741]: Make min() and max() supported in safe interpreters.

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}