diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclInterp.c | 19 | ||||
| -rw-r--r-- | tests/interp.test | 72 | ||||
| -rw-r--r-- | tests/safe.test | 6 |
4 files changed, 73 insertions, 29 deletions
@@ -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} |