summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/Interp.32
-rw-r--r--generic/tcl.h9
-rw-r--r--generic/tclBasic.c75
-rw-r--r--generic/tclExecute.c2
-rw-r--r--generic/tclInt.h6
-rw-r--r--library/init.tcl37
6 files changed, 87 insertions, 44 deletions
diff --git a/doc/Interp.3 b/doc/Interp.3
index 731007b..4ccff21 100644
--- a/doc/Interp.3
+++ b/doc/Interp.3
@@ -101,7 +101,7 @@ the command. The \fIfreeProc\fR field will be initialized to zero,
and \fIinterp->result\fR will point to an empty string. Commands that
do not return any value can simply leave the fields alone.
Furthermore, the empty string pointed to by \fIresult\fR is actually
-part of an array of \fBTCL_RESULT_SIZE\fR characters (approximately 200).
+part of an array of approximately 200 characters.
If a command wishes to return a short string, it can simply copy
it to the area pointed to by \fIinterp->result\fR. Or, it can use
the sprintf procedure to generate a short result string at the location
diff --git a/generic/tcl.h b/generic/tcl.h
index e85988f..147ead9 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -648,7 +648,9 @@ typedef struct stat *Tcl_OldStat_;
#define TCL_BREAK 3
#define TCL_CONTINUE 4
+#if !defined(TCL_NO_DEPRECATED)
#define TCL_RESULT_SIZE 200
+#endif
/*
*----------------------------------------------------------------------------
@@ -664,6 +666,7 @@ typedef struct stat *Tcl_OldStat_;
* Argument descriptors for math function callbacks in expressions:
*/
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
typedef enum {
TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
} Tcl_ValueType;
@@ -675,6 +678,10 @@ typedef struct Tcl_Value {
double doubleValue; /* Double-precision floating value. */
Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */
} Tcl_Value;
+#else
+#define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */
+#define Tcl_Value void /* Just enough to prevent compilation error in Tcl */
+#endif
/*
* Forward declaration of Tcl_Obj to prevent an error when the forward
@@ -846,7 +853,7 @@ typedef struct Tcl_SavedResult {
char *appendResult;
int appendAvl;
int appendUsed;
- char resultSpace[TCL_RESULT_SIZE+1];
+ char resultSpace[200+1];
} Tcl_SavedResult;
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a2afe08..286e773 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -118,6 +118,8 @@ static Tcl_ObjCmdProc ExprEntierFunc;
static Tcl_ObjCmdProc ExprFloorFunc;
static Tcl_ObjCmdProc ExprIntFunc;
static Tcl_ObjCmdProc ExprIsqrtFunc;
+static Tcl_ObjCmdProc ExprMaxFunc;
+static Tcl_ObjCmdProc ExprMinFunc;
static Tcl_ObjCmdProc ExprRandFunc;
static Tcl_ObjCmdProc ExprRoundFunc;
static Tcl_ObjCmdProc ExprSqrtFunc;
@@ -130,8 +132,10 @@ static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
static Tcl_NRPostProc NRCommand;
+#if !defined(TCL_NO_DEPRECATED)
static Tcl_ObjCmdProc OldMathFuncProc;
static void OldMathFuncDeleteProc(ClientData clientData);
+#endif /* !defined(TCL_NO_DEPRECATED) */
static void ProcessUnexpectedResult(Tcl_Interp *interp,
int returnCode);
static int RewindCoroutine(CoroutineData *corPtr, int result);
@@ -321,6 +325,8 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
{ "isqrt", ExprIsqrtFunc, NULL },
{ "log", ExprUnaryFunc, (ClientData) log },
{ "log10", ExprUnaryFunc, (ClientData) log10 },
+ { "max", ExprMaxFunc, NULL },
+ { "min", ExprMinFunc, NULL },
{ "pow", ExprBinaryFunc, (ClientData) pow },
{ "rand", ExprRandFunc, NULL },
{ "round", ExprRoundFunc, NULL },
@@ -3488,6 +3494,7 @@ TclCleanupCommand(
*----------------------------------------------------------------------
*/
+#if !defined(TCL_NO_DEPRECATED)
void
Tcl_CreateMathFunc(
Tcl_Interp *interp, /* Interpreter in which function is to be
@@ -3538,7 +3545,7 @@ Tcl_CreateMathFunc(
static int
OldMathFuncProc(
- ClientData clientData, /* Ponter to OldMathFuncData describing the
+ ClientData clientData, /* Pointer to OldMathFuncData describing the
* function being called */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Actual parameter count */
@@ -3819,6 +3826,7 @@ Tcl_ListMathFuncs(
return result;
}
+#endif /* !defined(TCL_NO_DEPRECATED) */
/*
*----------------------------------------------------------------------
@@ -7699,6 +7707,71 @@ ExprWideFunc(
return TCL_OK;
}
+/*
+ * Common implmentation of max() and min().
+ */
+static int
+ExprMaxMinFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
+ * function. */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv, /* Actual parameter vector. */
+ int op) /* Comparison direction */
+{
+ Tcl_Obj *res;
+ double d;
+ int type, i;
+ ClientData ptr;
+
+ if (objc < 2) {
+ MathFuncWrongNumArgs(interp, 2, objc, objv);
+ return TCL_ERROR;
+ }
+ res = objv[1];
+ for (i = 1; i < objc; i++) {
+ if (TclGetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (type == TCL_NUMBER_NAN) {
+ /*
+ * Get the error message for NaN.
+ */
+
+ Tcl_GetDoubleFromObj(interp, objv[i], &d);
+ return TCL_ERROR;
+ }
+ if (TclCompareTwoNumbers(objv[i], res) == op) {
+ res = objv[i];
+ }
+ }
+
+ Tcl_SetObjResult(interp, res);
+ return TCL_OK;
+}
+
+static int
+ExprMaxFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
+ * function. */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
+{
+ return ExprMaxMinFunc(clientData, interp, objc, objv, MP_GT);
+}
+
+static int
+ExprMinFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
+ * function. */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
+{
+ return ExprMaxMinFunc(clientData, interp, objc, objv, MP_LT);
+}
+
static int
ExprRandFunc(
ClientData clientData, /* Ignored. */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 54c73fd..95664d0 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -744,8 +744,6 @@ static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void DeleteExecStack(ExecStack *esPtr);
static void DupExprCodeInternalRep(Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr);
-MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
- Tcl_Obj *value2Ptr);
static Tcl_Obj * ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,
int opcode, Tcl_Obj **constants,
Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index ecd2924..aa338d5 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1937,10 +1937,10 @@ typedef struct Interp {
* variable traces change a variable in a
* gross way. */
#ifndef TCL_NO_DEPRECATED
- char resultSpace[TCL_RESULT_SIZE+1];
+ char resultSpace[TCL_DSTRING_STATIC_SIZE+1];
/* Static space holding small results. */
#else
- char resultSpaceDontUse[TCL_RESULT_SIZE+1];
+ char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
#endif
Tcl_Obj *objResultPtr; /* If the last command returned an object
* result, this points to it. Should not be
@@ -2908,6 +2908,8 @@ MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
+MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
+ Tcl_Obj *value2Ptr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
int *loc);
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
diff --git a/library/init.tcl b/library/init.tcl
index 13a4300..4424087 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -73,43 +73,6 @@ namespace eval tcl {
encoding dirs $Path
}
}
-
- # TIP #255 min and max functions
- namespace eval mathfunc {
- proc min {args} {
- if {![llength $args]} {
- return -code error \
- "too few arguments for math function \"min\""
- }
- set val Inf
- foreach arg $args {
- # This will handle forcing the numeric value without
- # ruining the internal type of a numeric object
- if {[catch {expr {double($arg)}} err]} {
- return -code error $err
- }
- if {$arg < $val} {set val $arg}
- }
- return $val
- }
- proc max {args} {
- if {![llength $args]} {
- return -code error \
- "too few arguments for math function \"max\""
- }
- set val -Inf
- foreach arg $args {
- # This will handle forcing the numeric value without
- # ruining the internal type of a numeric object
- if {[catch {expr {double($arg)}} err]} {
- return -code error $err
- }
- if {$arg > $val} {set val $arg}
- }
- return $val
- }
- namespace export min max
- }
}
namespace eval tcl::Pkg {}
generated by cgit v0.12 at 2025-12-09 10:41:53 (GMT)