summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--doc/mathfunc.n27
-rw-r--r--library/init.tcl44
-rw-r--r--tests/expr-old.test44
-rw-r--r--tests/info.test6
5 files changed, 114 insertions, 13 deletions
diff --git a/ChangeLog b/ChangeLog
index 09e6b1f..5d6fe50 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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