Tcl Source Code

Artifact Content
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

Artifact 785168c02e63cf9fff95517bd8e3efb1ef06d977:

Attachment "minmax.patch" to ticket [1309020fff] added by hobbs 2005-09-30 06:15:14.
? minmax.patch
? pkgs
? compat/zlib
? generic/hobbs
? generic/tclBasic.c.minmax
? unix/Makefile.in.pkgs
Index: doc/mathfunc.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/mathfunc.n,v
retrieving revision 1.6
diff -u -r1.6 mathfunc.n
--- doc/mathfunc.n	9 Jun 2005 14:24:06 -0000	1.6
+++ doc/mathfunc.n	29 Sep 2005 23:12:48 -0000
@@ -51,6 +51,10 @@
 .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 @@
 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 @@
 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.
Index: library/init.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/init.tcl,v
retrieving revision 1.81
diff -u -r1.81 init.tcl
--- library/init.tcl	14 Sep 2005 17:13:18 -0000	1.81
+++ library/init.tcl	29 Sep 2005 23:12:48 -0000
@@ -95,6 +95,48 @@
             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
Index: tests/expr-old.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/expr-old.test,v
retrieving revision 1.26
diff -u -r1.26 expr-old.test
--- tests/expr-old.test	28 Jul 2005 18:42:28 -0000	1.26
+++ tests/expr-old.test	29 Sep 2005 23:12:48 -0000
@@ -1055,6 +1055,48 @@
 } {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} {
Index: tests/info.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/info.test,v
retrieving revision 1.32
diff -u -r1.32 info.test
--- tests/info.test	29 Jul 2005 14:47:47 -0000	1.32
+++ tests/info.test	29 Sep 2005 23:12:48 -0000
@@ -627,9 +627,9 @@
 
 # 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