implementation for TIP #255, expr min/max

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