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
