diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | doc/mathfunc.n | 27 | ||||
| -rw-r--r-- | library/init.tcl | 44 | ||||
| -rw-r--r-- | tests/expr-old.test | 44 | ||||
| -rw-r--r-- | tests/info.test | 6 |
5 files changed, 114 insertions, 13 deletions
@@ -1,3 +1,9 @@ +2005-09-29 Jeff Hobbs <jeffh@ActiveState.com> + + * doc/mathfunc.n: implementation for TIP #255, expr min/max + * library/init.tcl: + * tests/info.test, tests/expr-old.test: + 2005-09-27 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> * tests/binary.test (binary-14.18): Added test for [Bug 1116542] diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 5ea56bc..9328d93 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: mathfunc.n,v 1.6 2005/06/09 14:24:06 dkf Exp $ +'\" RCS: @(#) $Id: mathfunc.n,v 1.7 2005/09/29 23:16:29 hobbs Exp $ '\" .so man.macros .TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions" @@ -51,6 +51,10 @@ package require \fBTcl 8.5\fR .br \fB::tcl::mathfunc::log10\fR \fIarg\fR .br +\fB::tcl::mathfunc::max\fR \fIarg\fR ?\fIarg\fR ...? +.br +\fB::tcl::mathfunc::min\fR \fIarg\fR ?\fIarg\fR ...? +.br \fB::tcl::mathfunc::pow\fR \fIx\fR \fIy\fR .br \fB::tcl::mathfunc::rand\fR @@ -87,13 +91,14 @@ Tcl supports the following mathematical functions in expressions, all of which work solely with floating-point numbers unless otherwise noted: .DS .ta 3c 6c 9c -\fBabs\fR \fBcos\fR \fBint\fR \fBsinh\fR -\fBacos\fR \fBcosh\fR \fBlog\fR \fBsqrt\fR -\fBasin\fR \fBdouble\fR \fBlog10\fR \fBsrand\fR -\fBatan\fR \fBexp\fR \fBpow\fR \fBtan\fR -\fBatan2\fR \fBfloor\fR \fBrand\fR \fBtanh\fR -\fBbool\fR \fBfmod\fR \fBround\fR \fBwide\fR -\fBceil\fR \fBhypot\fR \fBsin\fR +\fBabs\fR \fBacos\fR \fBasin\fR \fBatan\fR +\fBatan2\fR \fBbool\fR \fBceil\fR \fBcos\fR +\fBcosh\fR \fBdouble\fR \fBexp\fR \fBfloor\fR +\fBfmod\fR \fBhypot\fR \fBint\fR \fBlog\fR +\fBlog10\fR \fBmax\fR \fBmin\fR \fBpow\fR +\fBrand\fR \fBround\fR \fBsin\fR \fBsinh\fR +\fBsqrt\fR \fBsrand\fR \fBtan\fR \fBtanh\fR +\fBwide\fR .DE .PP .TP @@ -171,6 +176,12 @@ positive value. Returns the base 10 logarithm of \fIarg\fR. \fIArg\fR must be a positive value. .TP +\fBmax(\fIarg\fB, \fI...\fB)\fR +Returns the maximum value of all given numeric arguments. +.TP +\fBmin(\fIarg\fB, \fI...\fB)\fR +Returns the minimum value of all given numeric arguments. +.TP \fBpow(\fIx, y\fB)\fR Computes the value of \fIx\fR raised to the power \fIy\fR. If \fIx\fR is negative, \fIy\fR must be an integer value. diff --git a/library/init.tcl b/library/init.tcl index bd04e08..9551a1c 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.81 2005/09/14 17:13:18 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.82 2005/09/29 23:16:29 hobbs Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -95,6 +95,48 @@ namespace eval tcl { truncate ::tcl::chan::Truncate } } + + # TIP #255 min and max functions + namespace eval mathfunc { + proc min {args} { + if {[llength $args] == 0} { + return -code error \ + "too few arguments to math function \"min\"" + } + set val [lindex $args 0] + # This will handle forcing the numeric value without + # ruining the interval type of a numeric object + if {[catch {expr {double($val)}} err]} { + return -code error $err + } + foreach arg [lrange $args 1 end] { + if {[catch {expr {double($arg)}} err]} { + return -code error $err + } + if {$arg < $val} { set val $arg } + } + return $val + } + proc max {args} { + if {[llength $args] == 0} { + return -code error \ + "too few arguments to math function \"max\"" + } + set val [lindex $args 0] + # This will handle forcing the numeric value without + # ruining the interval type of a numeric object + if {[catch {expr {double($val)}} err]} { + return -code error $err + } + foreach arg [lrange $args 1 end] { + if {[catch {expr {double($arg)}} err]} { + return -code error $err + } + if {$arg > $val} { set val $arg } + } + return $val + } + } } # Windows specific end of initialization diff --git a/tests/expr-old.test b/tests/expr-old.test index 1817e9a..bb5a4fd 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr-old.test,v 1.26 2005/07/28 18:42:28 dgp Exp $ +# RCS: @(#) $Id: expr-old.test,v 1.27 2005/09/29 23:16:29 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -1055,6 +1055,48 @@ test expr-old-39.1 {Rounding with wide result} { } {1 1} unset -nocomplain x y +# +# TIP #255 min and max math functions +# + +test expr-old-40.1 {min math function} -body { + expr {min(0)} +} -result 0 +test expr-old-40.2 {min math function} -body { + expr {min(0.0)} +} -result 0.0 +test expr-old-40.3 {min math function} -body { + list [catch {expr {min()}} msg] $msg +} -result {1 {too few arguments to math function "min"}} +test expr-old-40.4 {min math function} -body { + expr {min(wide(-1) << 30, 4.5, -10)} +} -result [expr {wide(-1) << 30}] +test expr-old-40.5 {min math function} -body { + list [catch {expr {min("a", 0)}} msg] $msg +} -result {1 {argument to math function didn't have numeric value}} +test expr-old-40.6 {min math function} -body { + expr {min(300, "0xFF")} +} -result 255 + +test expr-old-41.1 {max math function} -body { + expr {max(0)} +} -result 0 +test expr-old-41.2 {max math function} -body { + expr {max(0.0)} +} -result 0.0 +test expr-old-41.3 {max math function} -body { + list [catch {expr {max()}} msg] $msg +} -result {1 {too few arguments to math function "max"}} +test expr-old-41.4 {max math function} -body { + expr {max(wide(1) << 30, 4.5, -10)} +} -result [expr {wide(1) << 30}] +test expr-old-41.5 {max math function} -body { + list [catch {expr {max("a", 0)}} msg] $msg +} -result {1 {argument to math function didn't have numeric value}} +test expr-old-41.6 {max math function} -body { + expr {max(200, "0xFF")} +} -result 255 + # Special test for Pentium arithmetic bug of 1994: if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} { diff --git a/tests/info.test b/tests/info.test index 9014eee..4cc6e32 100644 --- a/tests/info.test +++ b/tests/info.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: info.test,v 1.32 2005/07/29 14:47:47 dkf Exp $ +# RCS: @(#) $Id: info.test,v 1.33 2005/09/29 23:16:29 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -627,9 +627,9 @@ test info-19.6 {info vars: Bug 1072654} -setup { # Check whether the extra testing functions are defined... if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { - set functions {abs acos asin atan atan2 bool ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide} + set functions {abs acos asin atan atan2 bool ceil cos cosh double exp floor fmod hypot int log log10 max min pow rand round sin sinh sqrt srand tan tanh wide} } else { - set functions {T1 T2 T3 abs acos asin atan atan2 bool ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide} + set functions {T1 T2 T3 abs acos asin atan atan2 bool ceil cos cosh double exp floor fmod hypot int log log10 max min pow rand round sin sinh sqrt srand tan tanh wide} } test info-20.1 {info functions option} {info functions sin} sin test info-20.2 {info functions option} {lsort [info functions]} $functions |