From 9634dccb3c59f6e2b7902a6963363620fee62ccf Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 2 Jun 2019 11:59:53 +0000 Subject: Implement TIP 521, including tests --- generic/tclBasic.c | 280 +++++++++++++++++++++++++++++++++++++++++++++++++++++ tests/expr.test | 145 +++++++++++++++++++++++++-- 2 files changed, 419 insertions(+), 6 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d7eaf80..d11411d 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -129,6 +129,12 @@ static Tcl_ObjCmdProc ExprDoubleFunc; static Tcl_ObjCmdProc ExprFloorFunc; static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; +static Tcl_ObjCmdProc ExprIsFiniteFunc; +static Tcl_ObjCmdProc ExprIsInfinityFunc; +static Tcl_ObjCmdProc ExprIsNaNFunc; +static Tcl_ObjCmdProc ExprIsNormalFunc; +static Tcl_ObjCmdProc ExprIsSubnormalFunc; +static Tcl_ObjCmdProc ExprIsUnorderedFunc; static Tcl_ObjCmdProc ExprMaxFunc; static Tcl_ObjCmdProc ExprMinFunc; static Tcl_ObjCmdProc ExprRandFunc; @@ -137,6 +143,7 @@ static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; +static Tcl_ObjCmdProc FloatClassifyObjCmd; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; @@ -256,6 +263,7 @@ static const CmdInfo builtInCmds[] = { {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, + {"fpclassify", FloatClassifyObjCmd, NULL, NULL, CMD_IS_SAFE}, {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, @@ -424,7 +432,13 @@ static const BuiltinFuncDef BuiltinFuncTable[] = { { "fmod", ExprBinaryFunc, (ClientData) fmod }, { "hypot", ExprBinaryFunc, (ClientData) hypot }, { "int", ExprIntFunc, NULL }, + { "isfinite", ExprIsFiniteFunc, NULL }, + { "isinf", ExprIsInfinityFunc, NULL }, + { "isnan", ExprIsNaNFunc, NULL }, + { "isnormal", ExprIsNormalFunc, NULL }, { "isqrt", ExprIsqrtFunc, NULL }, + { "issubnormal", ExprIsSubnormalFunc, NULL, }, + { "isunordered", ExprIsUnorderedFunc, NULL, }, { "log", ExprUnaryFunc, (ClientData) log }, { "log10", ExprUnaryFunc, (ClientData) log10 }, { "max", ExprMaxFunc, NULL }, @@ -8283,6 +8297,272 @@ ExprSrandFunc( /* *---------------------------------------------------------------------- * + * Double Classification Functions -- + * + * This page contains the functions that implement all of the built-in + * math functions for classifying IEEE doubles. + * + * These have to be a little bit careful while Tcl_GetDoubleFromObj() + * rejects NaN values, which these functions *explicitly* accept. + * + * Results: + * Each function returns TCL_OK if it succeeds and pushes an Tcl object + * holding the result. If it fails it returns TCL_ERROR and leaves an + * error message in the interpreter's result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ExprIsFiniteFunc( + ClientData ignored, + Tcl_Interp *interp, /* The interpreter in which to execute the + * function. */ + int objc, /* Actual parameter count */ + Tcl_Obj *const *objv) /* Actual parameter list */ +{ + double d; + ClientData ptr; + int type, result = 0; + + if (objc != 2) { + MathFuncWrongNumArgs(interp, 2, objc, objv); + return TCL_ERROR; + } + + if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type != TCL_NUMBER_NAN) { + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + type = fpclassify(d); + result = (type != FP_INFINITE && type != FP_NAN); + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); + return TCL_OK; +} + +static int +ExprIsInfinityFunc( + ClientData ignored, + Tcl_Interp *interp, /* The interpreter in which to execute the + * function. */ + int objc, /* Actual parameter count */ + Tcl_Obj *const *objv) /* Actual parameter list */ +{ + double d; + ClientData ptr; + int type, result = 0; + + if (objc != 2) { + MathFuncWrongNumArgs(interp, 2, objc, objv); + return TCL_ERROR; + } + + if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type != TCL_NUMBER_NAN) { + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (fpclassify(d) == FP_INFINITE); + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); + return TCL_OK; +} + +static int +ExprIsNaNFunc( + ClientData ignored, + Tcl_Interp *interp, /* The interpreter in which to execute the + * function. */ + int objc, /* Actual parameter count */ + Tcl_Obj *const *objv) /* Actual parameter list */ +{ + double d; + ClientData ptr; + int type, result = 1; + + if (objc != 2) { + MathFuncWrongNumArgs(interp, 2, objc, objv); + return TCL_ERROR; + } + + if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type != TCL_NUMBER_NAN) { + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (fpclassify(d) == FP_NAN); + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); + return TCL_OK; +} + +static int +ExprIsNormalFunc( + ClientData ignored, + Tcl_Interp *interp, /* The interpreter in which to execute the + * function. */ + int objc, /* Actual parameter count */ + Tcl_Obj *const *objv) /* Actual parameter list */ +{ + double d; + ClientData ptr; + int type, result = 0; + + if (objc != 2) { + MathFuncWrongNumArgs(interp, 2, objc, objv); + return TCL_ERROR; + } + + if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type != TCL_NUMBER_NAN) { + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (fpclassify(d) == FP_NORMAL); + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); + return TCL_OK; +} + +static int +ExprIsSubnormalFunc( + ClientData ignored, + Tcl_Interp *interp, /* The interpreter in which to execute the + * function. */ + int objc, /* Actual parameter count */ + Tcl_Obj *const *objv) /* Actual parameter list */ +{ + double d; + ClientData ptr; + int type, result = 0; + + if (objc != 2) { + MathFuncWrongNumArgs(interp, 2, objc, objv); + return TCL_ERROR; + } + + if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type != TCL_NUMBER_NAN) { + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (fpclassify(d) == FP_SUBNORMAL); + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); + return TCL_OK; +} + +static int +ExprIsUnorderedFunc( + ClientData ignored, + Tcl_Interp *interp, /* The interpreter in which to execute the + * function. */ + int objc, /* Actual parameter count */ + Tcl_Obj *const *objv) /* Actual parameter list */ +{ + double d; + ClientData ptr; + int type, result = 0; + + if (objc != 3) { + MathFuncWrongNumArgs(interp, 3, objc, objv); + return TCL_ERROR; + } + + if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type == TCL_NUMBER_NAN) { + result = 1; + } else { + d = *((const double *) ptr); + result |= isnan(d); + } + + if (TclGetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type == TCL_NUMBER_NAN) { + result = 1; + } else { + d = *((const double *) ptr); + result |= isnan(d); + } + + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); + return TCL_OK; +} + +static int +FloatClassifyObjCmd( + ClientData ignored, + Tcl_Interp *interp, /* The interpreter in which to execute the + * function. */ + int objc, /* Actual parameter count */ + Tcl_Obj *const *objv) /* Actual parameter list */ +{ + double d; + Tcl_Obj *objPtr; + ClientData ptr; + int type; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); + return TCL_ERROR; + } + + if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type == TCL_NUMBER_NAN) { + goto gotNaN; + } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + switch (fpclassify(d)) { + case FP_INFINITE: + TclNewLiteralStringObj(objPtr, "infinite"); + break; + case FP_NAN: + gotNaN: + TclNewLiteralStringObj(objPtr, "nan"); + break; + case FP_NORMAL: + TclNewLiteralStringObj(objPtr, "normal"); + break; + case FP_SUBNORMAL: + TclNewLiteralStringObj(objPtr, "subnormal"); + break; + case FP_ZERO: + TclNewLiteralStringObj(objPtr, "zero"); + break; + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to classify number: %f", d)); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * MathFuncWrongNumArgs -- * * Generate an error message when a math function presents the wrong diff --git a/tests/expr.test b/tests/expr.test index cb0c24d..cbfc29c 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -133,7 +133,7 @@ proc do_twelve_days {} { unset xxx return $result } - + # start of tests catch {unset a b i x} @@ -7162,14 +7162,147 @@ test expr-52.1 { ::tcl::unsupported::representation $a]] } {0 0 1 1} +foreach func {isfinite isinf isnan isnormal issubnormal} { + test expr-53.1.$func {float classification: basic arg handling} -body { + expr ${func}() + } -returnCodes error -result "too few arguments for math function \"$func\"" + test expr-53.2.$func {float classification: basic arg handling} -body { + expr ${func}(1,2) + } -returnCodes error -result "too many arguments for math function \"$func\"" + test expr-53.3.$func {float classification: basic arg handling} -body { + expr ${func}(true) + } -returnCodes error -result {expected number but got "true"} + test expr-53.4.$func {float classification: basic arg handling} -body { + expr ${func}("gorp") + } -returnCodes error -result {expected number but got "gorp"} + test expr-53.5.$func {float classification: basic arg handling} -body { + expr ${func}(1.0) + } -match glob -result * + test expr-53.6.$func {float classification: basic arg handling} -body { + expr ${func}(0x123) + } -match glob -result * +} +test expr-54.0 {float classification: isfinite} {expr {isfinite(1.0)}} 1 +test expr-54.1 {float classification: isfinite} {expr {isfinite(-1.0)}} 1 +test expr-54.2 {float classification: isfinite} {expr {isfinite(0.0)}} 1 +test expr-54.3 {float classification: isfinite} {expr {isfinite(-0.0)}} 1 +test expr-54.4 {float classification: isfinite} {expr {isfinite(1/Inf)}} 1 +test expr-54.5 {float classification: isfinite} {expr {isfinite(-1/Inf)}} 1 +test expr-54.6 {float classification: isfinite} {expr {isfinite(1e-314)}} 1 +test expr-54.7 {float classification: isfinite} {expr {isfinite(inf)}} 0 +test expr-54.8 {float classification: isfinite} {expr {isfinite(-inf)}} 0 +test expr-54.9 {float classification: isfinite} {expr {isfinite(NaN)}} 0 -# cleanup -if {[info exists a]} { - unset a +test expr-55.0 {float classification: isinf} {expr {isinf(1.0)}} 0 +test expr-55.1 {float classification: isinf} {expr {isinf(-1.0)}} 0 +test expr-55.2 {float classification: isinf} {expr {isinf(0.0)}} 0 +test expr-55.3 {float classification: isinf} {expr {isinf(-0.0)}} 0 +test expr-55.4 {float classification: isinf} {expr {isinf(1/Inf)}} 0 +test expr-55.5 {float classification: isinf} {expr {isinf(-1/Inf)}} 0 +test expr-55.6 {float classification: isinf} {expr {isinf(1e-314)}} 0 +test expr-55.7 {float classification: isinf} {expr {isinf(inf)}} 1 +test expr-55.8 {float classification: isinf} {expr {isinf(-inf)}} 1 +test expr-55.9 {float classification: isinf} {expr {isinf(NaN)}} 0 + +test expr-56.0 {float classification: isnan} {expr {isnan(1.0)}} 0 +test expr-56.1 {float classification: isnan} {expr {isnan(-1.0)}} 0 +test expr-56.2 {float classification: isnan} {expr {isnan(0.0)}} 0 +test expr-56.3 {float classification: isnan} {expr {isnan(-0.0)}} 0 +test expr-56.4 {float classification: isnan} {expr {isnan(1/Inf)}} 0 +test expr-56.5 {float classification: isnan} {expr {isnan(-1/Inf)}} 0 +test expr-56.6 {float classification: isnan} {expr {isnan(1e-314)}} 0 +test expr-56.7 {float classification: isnan} {expr {isnan(inf)}} 0 +test expr-56.8 {float classification: isnan} {expr {isnan(-inf)}} 0 +test expr-56.9 {float classification: isnan} {expr {isnan(NaN)}} 1 + +test expr-57.0 {float classification: isnormal} {expr {isnormal(1.0)}} 1 +test expr-57.1 {float classification: isnormal} {expr {isnormal(-1.0)}} 1 +test expr-57.2 {float classification: isnormal} {expr {isnormal(0.0)}} 0 +test expr-57.3 {float classification: isnormal} {expr {isnormal(-0.0)}} 0 +test expr-57.4 {float classification: isnormal} {expr {isnormal(1/Inf)}} 0 +test expr-57.5 {float classification: isnormal} {expr {isnormal(-1/Inf)}} 0 +test expr-57.6 {float classification: isnormal} {expr {isnormal(1e-314)}} 0 +test expr-57.7 {float classification: isnormal} {expr {isnormal(inf)}} 0 +test expr-57.8 {float classification: isnormal} {expr {isnormal(-inf)}} 0 +test expr-57.9 {float classification: isnormal} {expr {isnormal(NaN)}} 0 + +test expr-58.0 {float classification: issubnormal} {expr {issubnormal(1.0)}} 0 +test expr-58.1 {float classification: issubnormal} {expr {issubnormal(-1.0)}} 0 +test expr-58.2 {float classification: issubnormal} {expr {issubnormal(0.0)}} 0 +test expr-58.3 {float classification: issubnormal} {expr {issubnormal(-0.0)}} 0 +test expr-58.4 {float classification: issubnormal} {expr {issubnormal(1/Inf)}} 0 +test expr-58.5 {float classification: issubnormal} {expr {issubnormal(-1/Inf)}} 0 +test expr-58.6 {float classification: issubnormal} {expr {issubnormal(1e-314)}} 1 +test expr-58.7 {float classification: issubnormal} {expr {issubnormal(inf)}} 0 +test expr-58.8 {float classification: issubnormal} {expr {issubnormal(-inf)}} 0 +test expr-58.9 {float classification: issubnormal} {expr {issubnormal(NaN)}} 0 + +test expr-59.0 {float classification: fpclassify} {fpclassify 1.0} normal +test expr-59.1 {float classification: fpclassify} {fpclassify -1.0} normal +test expr-59.2 {float classification: fpclassify} {fpclassify 0.0} zero +test expr-59.3 {float classification: fpclassify} {fpclassify -0.0} zero +test expr-59.4 {float classification: fpclassify} {fpclassify [expr 1/Inf]} zero +test expr-59.5 {float classification: fpclassify} {fpclassify [expr -1/Inf]} zero +test expr-59.6 {float classification: fpclassify} {fpclassify 1e-314} subnormal +test expr-59.7 {float classification: fpclassify} {fpclassify inf} infinite +test expr-59.8 {float classification: fpclassify} {fpclassify -inf} infinite +test expr-59.9 {float classification: fpclassify} {fpclassify NaN} nan +test expr-59.10 {float classification: fpclassify} -returnCodes error -body { + fpclassify +} -result {wrong # args: should be "fpclassify floatValue"} +test expr-59.11 {float classification: fpclassify} -returnCodes error -body { + fpclassify a b +} -result {wrong # args: should be "fpclassify floatValue"} +test expr-59.12 {float classification: fpclassify} -returnCodes error -body { + fpclassify gorp +} -result {expected number but got "gorp"} + +test expr-60.1 {float classification: basic arg handling} -body { + expr isunordered() +} -returnCodes error -result {too few arguments for math function "isunordered"} +test expr-60.2 {float classification: basic arg handling} -body { + expr isunordered(1) +} -returnCodes error -result {too few arguments for math function "isunordered"} +test expr-60.3 {float classification: basic arg handling} -body { + expr {isunordered(1, 2, 3)} +} -returnCodes error -result {too many arguments for math function "isunordered"} +test expr-60.4 {float classification: basic arg handling} -body { + expr {isunordered(true, 1.0)} +} -returnCodes error -result {expected number but got "true"} +test expr-60.5 {float classification: basic arg handling} -body { + expr {isunordered("gorp", 1.0)} +} -returnCodes error -result {expected number but got "gorp"} +test expr-60.6 {float classification: basic arg handling} -body { + expr {isunordered(0x123, 1.0)} +} -match glob -result * +test expr-60.7 {float classification: basic arg handling} -body { + expr {isunordered(1.0, true)} +} -returnCodes error -result {expected number but got "true"} +test expr-60.8 {float classification: basic arg handling} -body { + expr {isunordered(1.0, "gorp")} +} -returnCodes error -result {expected number but got "gorp"} +test expr-60.9 {float classification: basic arg handling} -body { + expr {isunordered(1.0, 0x123)} +} -match glob -result * + +# Big matrix of comparisons, but it's just a binary isinf() +set values {1.0 -1.0 0.0 -0.0 1e-314 Inf -Inf NaN} +set results {0 0 0 0 0 0 0 1} +set ctr 0 +foreach v1 $values r1 $results { + foreach v2 $values r2 $results { + test expr-61.[incr ctr] "float classification: isunordered($v1,$v2)" { + expr {isunordered($v1, $v2)} + } [expr {$r1 || $r2}] + } } -catch {unset min} -catch {unset max} +unset -nocomplain values results ctr + +# cleanup +unset -nocomplain a +unset -nocomplain min +unset -nocomplain max ::tcltest::cleanupTests return -- cgit v0.12 From 2dd78d392ca673b0f98e462c662f74de75196657 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 2 Jun 2019 13:44:50 +0000 Subject: Added docs --- doc/expr.n | 6 ++-- doc/fpclassify.n | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ doc/mathfunc.n | 81 ++++++++++++++++++++++++++++++++++++++++++++++++------ 3 files changed, 158 insertions(+), 12 deletions(-) create mode 100644 doc/fpclassify.n diff --git a/doc/expr.n b/doc/expr.n index 0210348..1b3cf9a 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -425,9 +425,9 @@ string(n), Tcl(n), while(n) arithmetic, boolean, compare, expression, fuzzy comparison .SH COPYRIGHT .nf -Copyright (c) 1993 The Regents of the University of California. -Copyright (c) 1994-2000 Sun Microsystems Incorporated. -Copyright (c) 2005 by Kevin B. Kenny . All rights reserved. +Copyright \(co 1993 The Regents of the University of California. +Copyright \(co 1994-2000 Sun Microsystems Incorporated. +Copyright \(co 2005 by Kevin B. Kenny . All rights reserved. .fi '\" Local Variables: '\" mode: nroff diff --git a/doc/fpclassify.n b/doc/fpclassify.n new file mode 100644 index 0000000..5bf21c5 --- /dev/null +++ b/doc/fpclassify.n @@ -0,0 +1,83 @@ +'\" +'\" Copyright (c) 2018 by Kevin B. Kenny . All rights reserved +'\" Copyright (c) 2019 by Donal Fellows +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH fpclassify n 8.7 Tcl "Tcl Float Classifier" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +fpclassify \- Floating point number classification of Tcl values +.SH SYNOPSIS +package require \fBTcl 8.7\fR +.sp +\fBfpclassify \fIvalue\fR +.BE +.SH DESCRIPTION +The \fBfpclassify\fR command takes a floating point number, \fIvalue\fR, and +returns one of the following strings that describe it: +.TP +\fBzero\fR +. +\fIvalue\fR is a floating point zero. +.TP +\fBsubnormal\fR +. +\fIvalue\fR is the result of a gradual underflow. +.TP +\fBnormal\fR +. +\fIvalue\fR is an ordinary floating-point number (not zero, subnormal, +infinite, nor NaN). +.TP +\fBinfinite\fR +. +\fIvalue\fR is a floating-point infinity. +.TP +\fBnan\fR +. +\fIvalue\fR is Not-a-Number. +.PP +The \fBfpclassify\fR command throws an error if value is not a floating-point +value and cannot be converted to one. +.SH EXAMPLE +.PP +This shows how to check whether the result of a computation is numerically +safe or not. (Note however that it does not guard against numerical errors; +just against representational problems.) +.PP +.CS +set value [command-that-computes-a-value] +switch [\fBfpclassify\fR $value] { + normal - zero { + puts "Result is $value" + } + infinite { + puts "Result is infinite" + } + subnormal { + puts "Result is $value - WARNING! precision lost" + } + nan { + puts "Computation completely failed" + } +} +.CE +.SH "SEE ALSO" +expr(n), mathfunc(n) +.SH KEYWORDS +floating point +.SH STANDARDS +This command depends on the \fBfpclassify\fR() C macro conforming to +.QW "ISO C99" +(i.e., to ISO/IEC 9899:1999). +.SH COPYRIGHT +.nf +Copyright \(co 2018 by Kevin B. Kenny . All rights reserved +.fi +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 7233d46..375d867 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -47,8 +47,24 @@ package require \fBTcl 8.5\fR .br \fB::tcl::mathfunc::int\fR \fIarg\fR .br +.VS "8.7, TIP 521" +\fB::tcl::mathfunc::isfinite\fR \fIarg\fR +.br +\fB::tcl::mathfunc::isinf\fR \fIarg\fR +.br +\fB::tcl::mathfunc::isnan\fR \fIarg\fR +.br +\fB::tcl::mathfunc::isnormal\fR \fIarg\fR +.VE "8.7, TIP 521" +.br \fB::tcl::mathfunc::isqrt\fR \fIarg\fR .br +.VS "8.7, TIP 521" +\fB::tcl::mathfunc::issubnormal\fR \fIarg\fR +.br +\fB::tcl::mathfunc::isunordered\fR \fIx y\fR +.VE "8.7, TIP 521" +.br \fB::tcl::mathfunc::log\fR \fIarg\fR .br \fB::tcl::mathfunc::log10\fR \fIarg\fR @@ -92,15 +108,17 @@ directly. 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 +.ta 3.2c 6.4c 9.6c \fBabs\fR \fBacos\fR \fBasin\fR \fBatan\fR \fBatan2\fR \fBbool\fR \fBceil\fR \fBcos\fR \fBcosh\fR \fBdouble\fR \fBentier\fR \fBexp\fR \fBfloor\fR \fBfmod\fR \fBhypot\fR \fBint\fR -\fBisqrt\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 +\fBisfinite\fR \fBisinf\fR \fBisnan\fR \fBisnormal\fR +\fBisqrt\fR \fBissubnormal\fR \fBisunordered\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 In addition to these predefined functions, applications may @@ -209,6 +227,34 @@ to the machine word size are returned as an integer value. For reference, the number of bytes in the machine word are stored in the \fBwordSize\fR element of the \fBtcl_platform\fR array. .TP +\fBisfinite \fIarg\fR +.VS "8.7, TIP 521" +Returns 1 if the floating-point number \fIarg\fR is finite. That is, if it is +zero, subnormal, or normal. Returns 0 if the number is infinite or NaN. Throws +an error if \fIarg\fR cannot be promoted to a floating-point value. +.VE "8.7, TIP 521" +.TP +\fBisinf \fIarg\fR +.VS "8.7, TIP 521" +Returns 1 if the floating-point number \fIarg\fR is infinite. Returns 0 if the +number is finite or NaN. Throws an error if \fIarg\fR cannot be promoted to a +floating-point value. +.VE "8.7, TIP 521" +.TP +\fBisnan \fIarg\fR +.VS "8.7, TIP 521" +Returns 1 if the floating-point number \fIarg\fR is Not-a-Number. Returns 0 if +the number is finite or infinite. Throws an error if \fIarg\fR cannot be +promoted to a floating-point value. +.VE "8.7, TIP 521" +.TP +\fBisnormal \fIarg\fR +.VS "8.7, TIP 521" +Returns 1 if the floating-point number \fIarg\fR is normal. Returns 0 if the +number is zero, subnormal, infinite or NaN. Throws an error if \fIarg\fR +cannot be promoted to a floating-point value. +.VE "8.7, TIP 521" +.TP \fBisqrt \fIarg\fR . Computes the integer part of the square root of \fIarg\fR. \fIArg\fR must be @@ -216,6 +262,23 @@ a positive value, either an integer or a floating point number. Unlike \fBsqrt\fR, which is limited to the precision of a floating point number, \fIisqrt\fR will return a result of arbitrary precision. .TP +\fBissubnormal \fIarg\fR +.VS "8.7, TIP 521" +Returns 1 if the floating-point number \fIarg\fR is subnormal, i.e., the +result of gradual underflow. Returns 0 if the number is zero, normal, infinite +or NaN. Throws an error if \fIarg\fR cannot be promoted to a floating-point +value. +.VE "8.7, TIP 521" +.TP +\fBisunordered \fIx y\fR +.VS "8.7, TIP 521" +Returns 1 if \fIx\fR and \fIy\fR cannot be compared for ordering, that is, if +either one is NaN. Returns 0 if both values can be ordered, that is, if they +are both chosen from among the set of zero, subnormal, normal and infinite +values. Throws an error if either \fIx\fR or \fIy\fR cannot be promoted to a +floating-point value. +.VE "8.7, TIP 521" +.TP \fBlog \fIarg\fR . Returns the natural logarithm of \fIarg\fR. \fIArg\fR must be a @@ -292,12 +355,12 @@ The argument may be any numeric value. The integer part of \fIarg\fR is determined, and then the low order 64 bits of that integer value are returned as an integer value. .SH "SEE ALSO" -expr(n), mathop(n), namespace(n) +expr(n), fpclassify(n), mathop(n), namespace(n) .SH "COPYRIGHT" .nf -Copyright (c) 1993 The Regents of the University of California. -Copyright (c) 1994-2000 Sun Microsystems Incorporated. -Copyright (c) 2005, 2006 by Kevin B. Kenny . +Copyright \(co 1993 The Regents of the University of California. +Copyright \(co 1994-2000 Sun Microsystems Incorporated. +Copyright \(co 2005, 2006 by Kevin B. Kenny . .fi '\" Local Variables: '\" mode: nroff -- cgit v0.12 From 85539b66a0aba5e82d17d3974d13370a13a5a64a Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 5 Jun 2019 19:34:11 +0000 Subject: Start of implementation of string comparison operators. --- generic/tclAssembly.c | 8 +++++++- generic/tclCompExpr.c | 47 ++++++++++++++++++++++++++++++++++++++++++----- generic/tclCompile.c | 9 +++++++++ generic/tclCompile.h | 8 +++++++- generic/tclExecute.c | 8 ++++++++ 5 files changed, 73 insertions(+), 7 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 47f7100..c70fb08 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -474,8 +474,12 @@ static const TalInstDesc TalInstructionTable[] = { {"strcat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1}, {"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1}, {"strfind", ASSEM_1BYTE, INST_STR_FIND, 2, 1}, + {"strge", ASSEM_1BYTE, INST_STR_GE, 2, 1}, + {"strgt", ASSEM_1BYTE, INST_STR_GT, 2, 1}, {"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1}, + {"strle", ASSEM_1BYTE, INST_STR_LE, 2, 1}, {"strlen", ASSEM_1BYTE, INST_STR_LEN, 1, 1}, + {"strlt", ASSEM_1BYTE, INST_STR_LT, 2, 1}, {"strmap", ASSEM_1BYTE, INST_STR_MAP, 3, 1}, {"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1}, {"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1}, @@ -517,6 +521,7 @@ static const unsigned char NonThrowingByteCodes[] = { INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ INST_JUMP1, INST_JUMP4, /* 34-35 */ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ + INST_STR_EQ, INST_STR_NEQ, INST_STR_CMP, INST_STR_LEN, /* 73-76 */ INST_LIST, /* 79 */ INST_OVER, /* 95 */ INST_PUSH_RETURN_OPTIONS, /* 108 */ @@ -531,7 +536,8 @@ static const unsigned char NonThrowingByteCodes[] = { INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 166-168 */ INST_CONCAT_STK, /* 169 */ INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE, /* 170-172 */ - INST_NUM_TYPE /* 180 */ + INST_NUM_TYPE, /* 180 */ + INST_STR_LT, INST_STR_GT, INST_STR_LE, INST_STR_GE /* 191-194 */ }; /* diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 56c8931..9b29f7b 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -281,7 +281,11 @@ enum Marks { * parse tree. The sub-expression between * parens becomes the single argument of the * matching OPEN_PAREN unary operator. */ -#define END (BINARY | 28) +#define STR_LT (BINARY | 28) +#define STR_GT (BINARY | 29) +#define STR_LEQ (BINARY | 30) +#define STR_GEQ (BINARY | 31) +#define END (BINARY | 32) /* This lexeme represents the end of the * string being parsed. Treating it as a * binary operator follows the same logic as @@ -360,12 +364,14 @@ static const unsigned char prec[] = { PREC_EQUAL, /* IN_LIST */ PREC_EQUAL, /* NOT_IN_LIST */ PREC_CLOSE_PAREN, /* CLOSE_PAREN */ + PREC_COMPARE, /* STR_LT */ + PREC_COMPARE, /* STR_GT */ + PREC_COMPARE, /* STR_LEQ */ + PREC_COMPARE, /* STR_GEQ */ PREC_END, /* END */ /* Expansion room for more binary operators */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, /* Unary operator lexemes */ PREC_UNARY, /* UNARY_PLUS */ PREC_UNARY, /* UNARY_MINUS */ @@ -415,12 +421,14 @@ static const unsigned char instruction[] = { INST_LIST_IN, /* IN_LIST */ INST_LIST_NOT_IN, /* NOT_IN_LIST */ 0, /* CLOSE_PAREN */ + INST_STR_LT, /* STR_LT */ + INST_STR_GT, /* STR_GT */ + INST_STR_LEQ, /* STR_LEQ */ + INST_STR_GEQ, /* STR_GEQ */ 0, /* END */ /* Expansion room for more binary operators */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, /* Unary operator lexemes */ INST_UPLUS, /* UNARY_PLUS */ INST_UMINUS, /* UNARY_MINUS */ @@ -2001,6 +2009,35 @@ ParseLexeme( return 2; } } + break; + + case 'l': + if ((numBytes > 1) + && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) { + switch (start[1]) { + case 't': + *lexemePtr = STR_LT; + return 2; + case 'e': + *lexemePtr = STR_LEQ; + return 2; + } + } + break; + + case 'g': + if ((numBytes > 1) + && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) { + switch (start[1]) { + case 't': + *lexemePtr = STR_GT; + return 2; + case 'e': + *lexemePtr = STR_GEQ; + return 2; + } + } + break; } literal = Tcl_NewObj(); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c53d3ad..65ea105 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -667,6 +667,15 @@ InstructionDesc const tclInstructionTable[] = { * default is pushed instead. * Stack: ... dict key1 ... keyN default => ... value */ + {"strlt", 1, -1, 0, {OPERAND_NONE}}, + /* String Less: push (stknext < stktop) */ + {"strgt", 1, -1, 0, {OPERAND_NONE}}, + /* String Greater: push (stknext > stktop) */ + {"strle", 1, -1, 0, {OPERAND_NONE}}, + /* String Less or equal: push (stknext <= stktop) */ + {"strge", 1, -1, 0, {OPERAND_NONE}}, + /* String Greater or equal: push (stknext >= stktop) */ + {NULL, 0, 0, 0, {OPERAND_NONE}} }; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 117fa46..686b2dd 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -842,8 +842,14 @@ typedef struct ByteCode { #define INST_DICT_GET_DEF 190 +/* TIP 461 */ +#define INST_STR_LT 191 +#define INST_STR_GT 192 +#define INST_STR_LE 193 +#define INST_STR_GE 194 + /* The last opcode */ -#define LAST_INST_OPCODE 190 +#define LAST_INST_OPCODE 194 /* * Table describing the Tcl bytecode instructions: their name (for displaying diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a2eed3f..7b692b7 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5084,6 +5084,10 @@ TEBCresume( case INST_STR_EQ: case INST_STR_NEQ: /* String (in)equality check */ case INST_STR_CMP: /* String compare. */ + case INST_STR_LT: + case INST_STR_GT: + case INST_STR_LE: + case INST_STR_GE: stringCompare: value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; @@ -5114,15 +5118,19 @@ TEBCresume( match = (match != 0); break; case INST_LT: + case INST_STR_LT: match = (match < 0); break; case INST_GT: + case INST_STR_GT: match = (match > 0); break; case INST_LE: + case INST_STR_LE: match = (match <= 0); break; case INST_GE: + case INST_STR_GE: match = (match >= 0); break; } -- cgit v0.12 From 89aeb7f43db3b0ab020b6be8f3ce354daa06121e Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 5 Jun 2019 20:35:02 +0000 Subject: And the command version of the new operators too. --- generic/tclBasic.c | 8 ++++++++ generic/tclCompCmdsSZ.c | 44 ++++++++++++++++++++++++++++++++++++++++++++ generic/tclCompExpr.c | 2 +- generic/tclInt.h | 30 ++++++++++++------------------ 4 files changed, 65 insertions(+), 19 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d7eaf80..9b37b5e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -504,6 +504,14 @@ static const OpCmdInfo mathOpCmds[] = { /* unused */ {0}, NULL}, { "eq", TclSortingOpCmd, TclCompileStreqOpCmd, /* unused */ {0}, NULL}, + { "lt", TclSortingOpCmd, TclCompileStrLtOpCmd, + /* unused */ {0}, NULL}, + { "le", TclSortingOpCmd, TclCompileStrLeOpCmd, + /* unused */ {0}, NULL}, + { "gt", TclSortingOpCmd, TclCompileStrGtOpCmd, + /* unused */ {0}, NULL}, + { "ge", TclSortingOpCmd, TclCompileStrGeOpCmd, + /* unused */ {0}, NULL}, { NULL, NULL, NULL, {0}, NULL} }; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 83ade0b..da45cb3 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -4493,6 +4493,50 @@ TclCompileStreqOpCmd( { return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr); } + +int +TclCompileStrLtOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) +{ + return CompileComparisonOpCmd(interp, parsePtr, INST_STR_LT, envPtr); +} + +int +TclCompileStrLeOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) +{ + return CompileComparisonOpCmd(interp, parsePtr, INST_STR_LE, envPtr); +} + +int +TclCompileStrGtOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) +{ + return CompileComparisonOpCmd(interp, parsePtr, INST_STR_GT, envPtr); +} + +int +TclCompileStrGeOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) +{ + return CompileComparisonOpCmd(interp, parsePtr, INST_STR_GE, envPtr); +} int TclCompileMinusOpCmd( diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 9b29f7b..2169a88 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2605,7 +2605,7 @@ TclSingleOpCmd( * * TclSortingOpCmd -- * Implements the commands: - * <, <=, >, >=, ==, eq + * <, <=, >, >=, ==, eq, lt, le, gt, ge * in the ::tcl::mathop namespace. These commands are defined for * arbitrary number of arguments by computing the AND of the base * operator applied to all neighbor argument pairs. diff --git a/generic/tclInt.h b/generic/tclInt.h index 933280a..3a6cb05 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4029,42 +4029,36 @@ MODULE_SCOPE int TclDivOpCmd(ClientData clientData, MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLessOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLeqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclGeqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclEqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclStreqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStrLtOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStrLeOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStrGtOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStrGeOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, -- cgit v0.12 From 9843b108c921e3c97a2e0d0d317f65ed1f144382 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 5 Jun 2019 20:42:32 +0000 Subject: And fix the silly error --- generic/tclCompExpr.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 2169a88..dec9600 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -423,8 +423,8 @@ static const unsigned char instruction[] = { 0, /* CLOSE_PAREN */ INST_STR_LT, /* STR_LT */ INST_STR_GT, /* STR_GT */ - INST_STR_LEQ, /* STR_LEQ */ - INST_STR_GEQ, /* STR_GEQ */ + INST_STR_LE, /* STR_LEQ */ + INST_STR_GE, /* STR_GEQ */ 0, /* END */ /* Expansion room for more binary operators */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -- cgit v0.12 From 9541b1276b8798d28ba4c6e4893994bad9f98297 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 6 Jun 2019 17:58:33 +0000 Subject: Tests and docs --- doc/expr.n | 59 ++++++++++++++++++++++++++++++++++++++++++------ doc/mathop.n | 67 ++++++++++++++++++++++++++++++++++++++++++++++--------- tests/expr.test | 20 +++++++++++++++++ tests/mathop.test | 44 ++++++++++++++++++++++++++++++++++-- 4 files changed, 171 insertions(+), 19 deletions(-) diff --git a/doc/expr.n b/doc/expr.n index 0210348..a7939f8 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -97,7 +97,7 @@ and the value of \fBb\fR is 6. The command on the left side of each line produces the value on the right side. .PP .CS -.ta 6c +.ta 8c \fBexpr\fR 3.1 + $a \fI6.1\fR \fBexpr\fR 2 + "$a.$b" \fI5.6\fR \fBexpr\fR 4*[llength "6 2"] \fI8\fR @@ -159,7 +159,18 @@ A right shift always propagates the sign bit. .TP 20 \fB<\0\0>\0\0<=\0\0>=\fR . -Boolean less than, greater than, less than or equal, and greater than or equal. +Boolean numeric-preferring comparisons: less than, greater than, less than or +equal, and greater than or equal. If either argument is not numeric, the +comparison is done using UNICODE string comparison, as with the string +comparison operators below, which have the same precedence. +.TP 20 +\fBlt\0\0gt\0\0le\0\0ge\fR +.VS "8.7, TIP461" +Boolean string comparisons: less than, greater than, less than or equal, and +greater than or equal. These always compare values using their UNICODE strings +(also see \fBstring compare\fR), unlike with the numeric-preferring +comparisons abov, which have the same precedence. +.VE "8.7, TIP461" .TP 20 \fB==\0\0!=\fR . @@ -190,16 +201,20 @@ Bit-wise OR. Valid for integer operands. \fB&&\fR . Logical AND. If both operands are true, the result is 1, or 0 otherwise. - +This operator evaluates lazily; it only evaluates its right-hand side if it +must in order to determine its result. .TP 20 \fB||\fR . Logical OR. If both operands are false, the result is 0, or 1 otherwise. +This operator evaluates lazily; it only evaluates its right-hand side if it +must in order to determine its result. .TP 20 -\fIx\fB?\fIy\fB:\fIz\fR +\fIx \fB?\fI y \fB:\fI z\fR . If-then-else, as in C. If \fIx\fR is false , the result is the value of \fIy\fR. Otherwise the result is the value of \fIz\fR. +This operator evaluates lazily; it only evaluates one of \fIy\fR or \fIz\fR. .PP The exponentiation operator promotes types in the same way that the multiply and divide operators do, and the result is is the same as the result of @@ -339,37 +354,67 @@ substitution on the value before \fBexpr\fR is called. In the following example, the value of the expression is 11 because the Tcl parser first substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR. Enclosing the expression in braces would result in a syntax error. +.PP .CS set a 3 set b {$a + 2} \fBexpr\fR $b*4 .CE .PP - -When an expression is generated at runtime, like the one above is, the bytcode +When an expression is generated at runtime, like the one above is, the bytecode compiler must ensure that new code is generated each time the expression is evaluated. This is the most costly kind of expression from a performance perspective. In such cases, consider directly using the commands described in the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR. - +.PP Most expressions are not formed at runtime, but are literal strings or contain substitutions that don't introduce other substitutions. To allow the bytecode compiler to work with an expression as a string literal at compilation time, ensure that it contains no substitutions or that it is enclosed in braces or otherwise quoted to prevent Tcl from performing substitutions, allowing \fBexpr\fR to perform them instead. +.PP +If it is necessary to include a non-constant expression string within the +wider context of an otherwise-constant expression, the most efficient +technique is to put the varying part inside a recursive \fBexpr\fR, as this at +least allows for the compilation of the outer part, though it does mean that +the varying part must itself be evaluated as a separate expression. Thus, in +this example the result is 20 and the outer expression benefits from fully +cached bytecode compilation. +.PP +.CS +set a 3 +set b {$a + 2} +\fBexpr\fR {[\fBexpr\fR $b] * 4} +.CE +.PP +In general, you should enclose your expression in braces wherever possible, +and where not possible, the argument to \fBexpr\fR should be an expression +defined elsewhere as simply as possible. It is usually more efficient and +safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR +namespace) than it is to do complex expression generation. .SH EXAMPLES .PP A numeric comparison whose result is 1: +.PP .CS \fBexpr\fR {"0x03" > "2"} .CE .PP A string comparison whose result is 1: +.PP .CS \fBexpr\fR {"0y" > "0x12"} .CE .PP +.VS "8.7, TIP461" +A forced string comparison whose result is 0: +.PP +.CS +\fBexpr\fR {"0x03" gt "2"} +.CE +.VE "8.7, TIP461" +.PP Define a procedure that computes an .QW interesting mathematical function: diff --git a/doc/mathop.n b/doc/mathop.n index 84cf308..1c70e95 100644 --- a/doc/mathop.n +++ b/doc/mathop.n @@ -55,6 +55,16 @@ package require \fBTcl 8.5\fR .br \fB::tcl::mathop::ne\fR \fIarg arg\fR .br +.VS "8.7, TIP461" +\fB::tcl::mathop::lt\fR ?\fIarg\fR ...? +.br +\fB::tcl::mathop::le\fR ?\fIarg\fR ...? +.br +\fB::tcl::mathop::gt\fR ?\fIarg\fR ...? +.br +\fB::tcl::mathop::ge\fR ?\fIarg\fR ...? +.VE "8.7, TIP461" +.br \fB::tcl::mathop::in\fR \fIarg list\fR .br \fB::tcl::mathop::ni\fR \fIarg list\fR @@ -76,7 +86,8 @@ The following operator commands are supported: \fB/\fR \fB%\fR \fB**\fR \fB&\fR \fB|\fR \fB^\fR \fB>>\fR \fB<<\fR \fB==\fR \fBeq\fR \fB!=\fR \fBne\fR \fB<\fR \fB<=\fR \fB>\fR -\fB>=\fR \fBin\fR \fBni\fR +\fB>=\fR \fBin\fR \fBni\fR \fBlt\fR \fBle\fR +\fBgt\fR \fBge\fR .DE .SS "MATHEMATICAL OPERATORS" .PP @@ -192,8 +203,8 @@ after the first having to be strictly more than the one preceding it. Comparisons are performed preferentially on the numeric values, and are otherwise performed using UNICODE string comparison. If fewer than two arguments are present, this operation always returns a true value. When the -arguments are numeric but should be compared as strings, the \fBstring -compare\fR command should be used instead. +arguments are numeric but should be compared as strings, the \fBlt\fR +operator or the \fBstring compare\fR command should be used instead. .TP \fB<=\fR ?\fIarg\fR ...? . @@ -202,8 +213,8 @@ after the first having to be equal to or more than the one preceding it. Comparisons are performed preferentially on the numeric values, and are otherwise performed using UNICODE string comparison. If fewer than two arguments are present, this operation always returns a true value. When the -arguments are numeric but should be compared as strings, the \fBstring -compare\fR command should be used instead. +arguments are numeric but should be compared as strings, the \fBle\fR +operator or the \fBstring compare\fR command should be used instead. .TP \fB>\fR ?\fIarg\fR ...? . @@ -212,8 +223,8 @@ after the first having to be strictly less than the one preceding it. Comparisons are performed preferentially on the numeric values, and are otherwise performed using UNICODE string comparison. If fewer than two arguments are present, this operation always returns a true value. When the -arguments are numeric but should be compared as strings, the \fBstring -compare\fR command should be used instead. +arguments are numeric but should be compared as strings, the \fBgt\fR +operator or the \fBstring compare\fR command should be used instead. .TP \fB>=\fR ?\fIarg\fR ...? . @@ -222,8 +233,40 @@ after the first having to be equal to or less than the one preceding it. Comparisons are performed preferentially on the numeric values, and are otherwise performed using UNICODE string comparison. If fewer than two arguments are present, this operation always returns a true value. When the -arguments are numeric but should be compared as strings, the \fBstring -compare\fR command should be used instead. +arguments are numeric but should be compared as strings, the \fBge\fR +operator or the \fBstring compare\fR command should be used instead. +.TP +\fBlt\fR ?\fIarg\fR ...? +.VS "8.7, TIP461" +Returns whether the arbitrarily-many arguments are ordered, with each argument +after the first having to be strictly more than the one preceding it. +Comparisons are performed using UNICODE string comparison. If fewer than two +arguments are present, this operation always returns a true value. +.VE "8.7, TIP461" +.TP +\fBle\fR ?\fIarg\fR ...? +.VS "8.7, TIP461" +Returns whether the arbitrarily-many arguments are ordered, with each argument +after the first having to be equal to or strictly more than the one preceding it. +Comparisons are performed using UNICODE string comparison. If fewer than two +arguments are present, this operation always returns a true value. +.VE "8.7, TIP461" +.TP +\fBgt\fR ?\fIarg\fR ...? +.VS "8.7, TIP461" +Returns whether the arbitrarily-many arguments are ordered, with each argument +after the first having to be strictly less than the one preceding it. +Comparisons are performed using UNICODE string comparison. If fewer than two +arguments are present, this operation always returns a true value. +.VE "8.7, TIP461" +.TP +\fBge\fR ?\fIarg\fR ...? +.VS "8.7, TIP461" +Returns whether the arbitrarily-many arguments are ordered, with each argument +after the first having to be equal to or strictly less than the one preceding it. +Comparisons are performed using UNICODE string comparison. If fewer than two +arguments are present, this operation always returns a true value. +.VE "8.7, TIP461" .SS "BIT-WISE OPERATORS" .PP The behaviors of the bit-wise operator commands (all of which only operate on @@ -299,8 +342,12 @@ set gotIt [\fBin\fR 3 $list] \fI# Test to see if a value is within some defined range\fR set inRange [\fB<=\fR 1 $x 5] -\fI# Test to see if a list is sorted\fR +\fI# Test to see if a list is numerically sorted\fR set sorted [\fB<=\fR {*}$list] + +\fI# Test to see if a list is lexically sorted\fR +set alphaList {a b c d e f} +set sorted [\fBle\fR {*}$alphaList] .CE .SH "SEE ALSO" expr(n), mathfunc(n), namespace(n) diff --git a/tests/expr.test b/tests/expr.test index cb0c24d..01c5213 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -411,6 +411,26 @@ test expr-8.34 {expr edge cases} -body { test expr-8.35 {expr edge cases} -body { expr {1ea} } -returnCodes error -match glob -result * +test expr-8.36 {CompileEqualtyExpr: string comparison ops} { + set x 012 + set y 0x0 + list [expr {$x < $y}] [expr {$x lt $y}] [expr {$x lt $x}] +} {0 1 0} +test expr-8.37 {CompileEqualtyExpr: string comparison ops} { + set x 012 + set y 0x0 + list [expr {$x <= $y}] [expr {$x le $y}] [expr {$x le $x}] +} {0 1 1} +test expr-8.38 {CompileEqualtyExpr: string comparison ops} { + set x 012 + set y 0x0 + list [expr {$x > $y}] [expr {$x gt $y}] [expr {$x gt $x}] +} {1 0 0} +test expr-8.39 {CompileEqualtyExpr: string comparison ops} { + set x 012 + set y 0x0 + list [expr {$x >= $y}] [expr {$x ge $y}] [expr {$x ge $x}] +} {1 0 1} test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12 test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63 diff --git a/tests/mathop.test b/tests/mathop.test index a1a3f80..958a56f 100644 --- a/tests/mathop.test +++ b/tests/mathop.test @@ -95,7 +95,7 @@ proc TestOp {op args} { } return [lindex $results 0] } - + # start of tests namespace eval ::testmathop { @@ -1342,6 +1342,46 @@ test mathop-26.2 { misc ops, corner cases } { set res } [list 2147483648 9223372036854775808 9223372036854775808 4294967296 18446744073709551616] +test mathop-27.1 {lt operator} {::tcl::mathop::lt} 1 +test mathop-27.2 {lt operator} {::tcl::mathop::lt a} 1 +test mathop-27.3 {lt operator} {::tcl::mathop::lt a b} 1 +test mathop-27.4 {lt operator} {::tcl::mathop::lt b a} 0 +test mathop-27.5 {lt operator} {::tcl::mathop::lt a a} 0 +test mathop-27.6 {lt operator} {::tcl::mathop::lt a b c} 1 +test mathop-27.7 {lt operator} {::tcl::mathop::lt b a c} 0 +test mathop-27.8 {lt operator} {::tcl::mathop::lt a c b} 0 +test mathop-27.9 {lt operator} {::tcl::mathop::lt 012 0x0} 1 + +test mathop-28.1 {le operator} {::tcl::mathop::le} 1 +test mathop-28.2 {le operator} {::tcl::mathop::le a} 1 +test mathop-28.3 {le operator} {::tcl::mathop::le a b} 1 +test mathop-28.4 {le operator} {::tcl::mathop::le b a} 0 +test mathop-28.5 {le operator} {::tcl::mathop::le a a} 1 +test mathop-28.6 {le operator} {::tcl::mathop::le a b c} 1 +test mathop-28.7 {le operator} {::tcl::mathop::le b a c} 0 +test mathop-28.8 {le operator} {::tcl::mathop::le a c b} 0 +test mathop-28.9 {le operator} {::tcl::mathop::le 012 0x0} 1 + +test mathop-29.1 {gt operator} {::tcl::mathop::gt} 1 +test mathop-29.2 {gt operator} {::tcl::mathop::gt a} 1 +test mathop-29.3 {gt operator} {::tcl::mathop::gt a b} 0 +test mathop-29.4 {gt operator} {::tcl::mathop::gt b a} 1 +test mathop-29.5 {gt operator} {::tcl::mathop::gt a a} 0 +test mathop-29.6 {gt operator} {::tcl::mathop::gt c b a} 1 +test mathop-29.7 {gt operator} {::tcl::mathop::gt b a c} 0 +test mathop-29.8 {gt operator} {::tcl::mathop::gt a c b} 0 +test mathop-29.9 {gt operator} {::tcl::mathop::gt 0x0 012} 1 + +test mathop-30.1 {ge operator} {::tcl::mathop::ge} 1 +test mathop-30.2 {ge operator} {::tcl::mathop::ge a} 1 +test mathop-30.3 {ge operator} {::tcl::mathop::ge a b} 0 +test mathop-30.4 {ge operator} {::tcl::mathop::ge b a} 1 +test mathop-30.5 {ge operator} {::tcl::mathop::ge a a} 1 +test mathop-30.6 {ge operator} {::tcl::mathop::ge c b a} 1 +test mathop-30.7 {ge operator} {::tcl::mathop::ge b a c} 0 +test mathop-30.8 {ge operator} {::tcl::mathop::ge a c b} 0 +test mathop-30.9 {ge operator} {::tcl::mathop::ge 0x0 012} 1 + if 0 { # Compare ops to expr bytecodes namespace import ::tcl::mathop::* @@ -1354,7 +1394,7 @@ if 0 { _X 3 4 5 set ::tcl_traceCompile 0 } - + # cleanup namespace delete ::testmathop namespace delete ::testmathop2 -- cgit v0.12 From 774c2050f147750c96d391c1150c8026a9864ac3 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Jun 2019 18:24:05 +0000 Subject: Remove declarations that are never defined. --- generic/tclInt.h | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 57367fa..821a39f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3287,39 +3287,21 @@ MODULE_SCOPE int TclDivOpCmd(ClientData clientData, MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLessOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLeqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclGeqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclEqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclStreqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -- cgit v0.12 From 5f72a5554c21a6f9ef8f355452fd19c1914da786 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Jun 2019 18:33:28 +0000 Subject: More bytecodes are non-throwing. --- generic/tclAssembly.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index b6bebb6..1a5e5f4 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -513,6 +513,7 @@ static const unsigned char NonThrowingByteCodes[] = { INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ INST_JUMP1, INST_JUMP4, /* 34-35 */ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ + INST_STR_EQ, INST_STR_NEQ, INST_STR_CMP, INST_STR_LEN, /* 73-76 */ INST_LIST, /* 79 */ INST_OVER, /* 95 */ INST_PUSH_RETURN_OPTIONS, /* 108 */ -- cgit v0.12 From 39fba10b45e247bf94cdca222334c7cd4eb40087 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Jun 2019 18:44:18 +0000 Subject: More localized documentation of lazy operators. --- doc/expr.n | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/doc/expr.n b/doc/expr.n index 2a0af7e..58a4b7f 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -106,7 +106,7 @@ Then the command on the left side of each of the lines below will produce the value on the right side of the line: .PP .CS -.ta 6c +.ta 8c \fBexpr\fR 3.1 + $a \fI6.1\fR \fBexpr\fR 2 + "$a.$b" \fI5.6\fR \fBexpr\fR 4*[llength "6 2"] \fI8\fR @@ -201,18 +201,23 @@ Bit-wise OR. Valid for integer operands only. Logical AND. Produces a 1 result if both operands are non-zero, 0 otherwise. Valid for boolean and numeric (integers or floating-point) operands only. +This operator evaluates lazily; it only evaluates its second operand if it +must in order to determine its result. .TP 20 \fB||\fR . Logical OR. Produces a 0 result if both operands are zero, 1 otherwise. Valid for boolean and numeric (integers or floating-point) operands only. +This operator evaluates lazily; it only evaluates its second operand if it +must in order to determine its result. .TP 20 -\fIx\fB?\fIy\fB:\fIz\fR +\fIx \fB?\fI y \fB:\fI z\fR . If-then-else, as in C. If \fIx\fR evaluates to non-zero, then the result is the value of \fIy\fR. Otherwise the result is the value of \fIz\fR. The \fIx\fR operand must have a boolean or numeric value. +This operator evaluates lazily; it evaluates only one of \fIy\fR or \fIz\fR. .PP See the C manual for more details on the results produced by each operator. -- cgit v0.12 From 6a3773f6119ffaee96382a12d282e033a6a0bf95 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Jun 2019 18:58:44 +0000 Subject: Doc formatting and advice about double substitution in expressions. --- doc/expr.n | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/doc/expr.n b/doc/expr.n index 6acc4bf..996407a 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -343,25 +343,45 @@ substitution on the value before \fBexpr\fR is called. In the following example, the value of the expression is 11 because the Tcl parser first substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR. Enclosing the expression in braces would result in a syntax error. +.PP .CS set a 3 set b {$a + 2} \fBexpr\fR $b*4 .CE .PP - -When an expression is generated at runtime, like the one above is, the bytcode +When an expression is generated at runtime, like the one above is, the bytecode compiler must ensure that new code is generated each time the expression is evaluated. This is the most costly kind of expression from a performance perspective. In such cases, consider directly using the commands described in the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR. - +.PP Most expressions are not formed at runtime, but are literal strings or contain substitutions that don't introduce other substitutions. To allow the bytecode compiler to work with an expression as a string literal at compilation time, ensure that it contains no substitutions or that it is enclosed in braces or otherwise quoted to prevent Tcl from performing substitutions, allowing \fBexpr\fR to perform them instead. +.PP +If it is necessary to include a non-constant expression string within the +wider context of an otherwise-constant expression, the most efficient +technique is to put the varying part inside a recursive \fBexpr\fR, as this at +least allows for the compilation of the outer part, though it does mean that +the varying part must itself be evaluated as a separate expression. Thus, in +this example the result is 20 and the outer expression benefits from fully +cached bytecode compilation. +.PP +.CS +set a 3 +set b {$a + 2} +\fBexpr\fR {[\fBexpr\fR $b] * 4} +.CE +.PP +In general, you should enclose your expression in braces wherever possible, +and where not possible, the argument to \fBexpr\fR should be an expression +defined elsewhere as simply as possible. It is usually more efficient and +safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR +namespace) than it is to do complex expression generation. .SH EXAMPLES .PP A numeric comparison whose result is 1: -- cgit v0.12 From f627e6922c20d26f51c6cc68be1796be135515aa Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Jun 2019 19:09:16 +0000 Subject: more formatting --- doc/expr.n | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/expr.n b/doc/expr.n index 996407a..5263c07 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -385,11 +385,13 @@ namespace) than it is to do complex expression generation. .SH EXAMPLES .PP A numeric comparison whose result is 1: +.PP .CS \fBexpr\fR {"0x03" > "2"} .CE .PP A string comparison whose result is 1: +.PP .CS \fBexpr\fR {"0y" > "0x12"} .CE -- cgit v0.12 From 1cab268c94cced7c8dcb6d2ebb7793cb4b64ed2f Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 10 Jun 2019 19:27:31 +0000 Subject: General improvements to the expr manpage --- doc/expr.n | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 65 insertions(+), 15 deletions(-) diff --git a/doc/expr.n b/doc/expr.n index 6c83504..aefaf0b 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -26,9 +26,11 @@ as the corresponding C operators. Expressions almost always yield numeric results (integer or floating-point values). For example, the expression +.PP .CS \fBexpr 8.2 + 6\fR .CE +.PP evaluates to 14.2. Tcl expressions differ from C expressions in the way that operands are specified. Also, Tcl expressions support @@ -103,8 +105,9 @@ For some examples of simple expressions, suppose the variable the variable \fBb\fR has the value 6. Then the command on the left side of each of the lines below will produce the value on the right side of the line: +.PP .CS -.ta 6c +.ta 9c \fBexpr\fR 3.1 + $a \fI6.1\fR \fBexpr\fR 2 + "$a.$b" \fI5.6\fR \fBexpr\fR 4*[llength "6 2"] \fI8\fR @@ -189,16 +192,21 @@ Bit-wise OR. Valid for integer operands only. Logical AND. Produces a 1 result if both operands are non-zero, 0 otherwise. Valid for boolean and numeric (integers or floating-point) operands only. +This operator evaluates lazily; it only evaluates its right-hand side if it +must in order to determine its result. .TP 20 \fB||\fR Logical OR. Produces a 0 result if both operands are zero, 1 otherwise. Valid for boolean and numeric (integers or floating-point) operands only. +This operator evaluates lazily; it only evaluates its right-hand side if it +must in order to determine its result. .TP 20 -\fIx\fB?\fIy\fB:\fIz\fR +\fIx \fB? \fIy \fB: \fIz\fR If-then-else, as in C. If \fIx\fR evaluates to non-zero, then the result is the value of \fIy\fR. Otherwise the result is the value of \fIz\fR. The \fIx\fR operand must have a boolean or numeric value. +This operator evaluates lazily; it only evaluates one of \fIy\fR or \fIz\fR. .LP See the C manual for more details on the results produced by each operator. @@ -209,18 +217,22 @@ of the \fBpow\fR function (after any type conversions.) .VE 8.5 All of the binary operators group left-to-right within the same precedence level. For example, the command +.PP .CS \fBexpr\fR {4*2 < 7} .CE +.PP returns 0. .PP The \fB&&\fR, \fB||\fR, and \fB?:\fR operators have .QW "lazy evaluation" , just as in C, which means that operands are not evaluated if they are not needed to determine the outcome. For example, in the command +.PP .CS -\fBexpr {$v ? [a] : [b]}\fR +\fBexpr\fR {$v ? [a] : [b]} .CE +.PP only one of .QW \fB[a]\fR or @@ -238,18 +250,23 @@ before invoking the \fBexpr\fR command. .VS 8.5 When the expression parser encounters a mathematical function such as \fBsin($x)\fR, it replaces it with a call to an ordinary -Tcl function in the \fBtcl::mathfunc\fR namespace. The processing +Tcl command in the \fBtcl::mathfunc\fR namespace. The processing of an expression such as: +.PP .CS -\fBexpr {sin($x+$y)}\fR +\fBexpr\fR {sin($x+$y)} .CE +.PP is the same in every way as the processing of: +.PP .CS -\fBexpr {[tcl::mathfunc::sin [expr {$x+$y}]]}\fR +\fBexpr\fR {[tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]]} .CE +.PP which in turn is the same as the processing of: +.PP .CS -\fBtcl::mathfunc::sin [expr {$x+$y}]\fR +tcl::mathfunc::sin [\fBexpr\fR {$x+$y}] .CE .PP The executor will search for \fBtcl::mathfunc::sin\fR using the usual @@ -288,23 +305,29 @@ and string operands is done automatically as needed. For arithmetic computations, integers are used until some floating-point number is introduced, after which floating-point is used. For example, +.PP .CS \fBexpr\fR {5 / 4} .CE +.PP returns 1, while +.PP .CS \fBexpr\fR {5 / 4.0} \fBexpr\fR {5 / ( [string length "abcd"] + 0.0 )} .CE +.PP both return 1.25. Floating-point values are always returned with a .QW \fB.\fR or an .QW \fBe\fR so that they will not look like integer values. For example, +.PP .CS \fBexpr\fR {20.0/5.0} .CE +.PP returns \fB4.0\fR, not \fB4\fR. .SS "STRING OPERATIONS" .PP @@ -320,10 +343,12 @@ Canonical string representation for integer values is a decimal string format. Canonical string representation for floating-point values is that produced by the \fB%g\fR format specifier of Tcl's \fBformat\fR command. For example, the commands +.PP .CS -\fBexpr {"0x03" > "2"}\fR -\fBexpr {"0y" > "0x12"}\fR +\fBexpr\fR {"0x03" > "2"} +\fBexpr\fR {"0y" > "0x12"} .CE +.PP both return 1. The first comparison is done using integer comparison, and the second is done using string comparison. Because of Tcl's tendency to treat values as numbers whenever @@ -340,15 +365,19 @@ This allows the Tcl bytecode compiler to generate the best code. As mentioned above, expressions are substituted twice: once by the Tcl parser and once by the \fBexpr\fR command. For example, the commands +.PP .CS -\fBset a 3\fR -\fBset b {$a + 2}\fR -\fBexpr $b*4\fR +set a 3 +set b {$a + 2} +\fBexpr\fR $b*4 .CE +.PP return 11, not a multiple of 4. -This is because the Tcl parser will first substitute \fB$a + 2\fR for -the variable \fBb\fR, -then the \fBexpr\fR command will evaluate the expression \fB$a + 2*4\fR. +This is because the Tcl parser will first substitute +.QW "\fB$a + 2\fR" +for the variable \fBb\fR, +then the \fBexpr\fR command will evaluate the expression +.QW "\fB$a + 2*4\fR" . .PP Most expressions do not require a second round of substitutions. Either they are enclosed in braces or, if not, @@ -362,6 +391,21 @@ The most expensive code is required for unbraced expressions that contain command substitutions. These expressions must be implemented by generating new code each time the expression is executed. +.PP +If it is necessary to include a non-constant expression string within the +wider context of an otherwise-constant expression, the most efficient +technique is to put the varying part inside a recursive \fBexpr\fR, as this at +least allows for the compilation of the outer part, though it does mean that +the varying part must itself be evaluated as a separate expression. Thus, in +this example the result is 20 and the outer expression benefits from fully +cached bytecode compilation. +.PP +.CS +set a 3 +set b {$a + 2} +\fBexpr\fR {[\fBexpr\fR $b] * 4} +.CE +.PP .VS 8.5 When the expression is unbraced to allow the substitution of a function or operator, consider using the commands documented in the \fBmathfunc\fR(n) or @@ -371,6 +415,7 @@ operator, consider using the commands documented in the \fBmathfunc\fR(n) or Define a procedure that computes an .QW interesting mathematical function: +.PP .CS proc tcl::mathfunc::calc {x y} { \fBexpr\fR { ($x**2 - $y**2) / exp($x**2 + $y**2) } @@ -378,6 +423,7 @@ proc tcl::mathfunc::calc {x y} { .CE .PP Convert polar coordinates into cartesian coordinates: +.PP .CS # convert from ($radius,$angle) set x [\fBexpr\fR { $radius * cos($angle) }] @@ -385,6 +431,7 @@ set y [\fBexpr\fR { $radius * sin($angle) }] .CE .PP Convert cartesian coordinates into polar coordinates: +.PP .CS # convert from ($x,$y) set radius [\fBexpr\fR { hypot($y, $x) }] @@ -393,12 +440,14 @@ set angle [\fBexpr\fR { atan2($y, $x) }] .PP Print a message describing the relationship of two string values to each other: +.PP .CS puts "a and b are [\fBexpr\fR {$a eq $b ? {equal} : {different}}]" .CE .PP Set a variable to whether an environment variable is both defined at all and also set to a true boolean value: +.PP .CS set isTrue [\fBexpr\fR { [info exists ::env(SOME_ENV_VAR)] && @@ -407,6 +456,7 @@ set isTrue [\fBexpr\fR { .CE .PP Generate a random integer in the range 0..99 inclusive: +.PP .CS set randNum [\fBexpr\fR { int(100 * rand()) }] .CE -- cgit v0.12 From 3716148be649380b65f5c3f646578f1bbd77af49 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Jun 2019 19:50:03 +0000 Subject: update test --- tests/info.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/info.test b/tests/info.test index c6f3108..ce51523 100644 --- a/tests/info.test +++ b/tests/info.test @@ -655,7 +655,7 @@ test info-19.6 {info vars: Bug 1072654} -setup { namespace delete x } -result {} -set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isqrt log log10 max min pow rand round sin sinh sqrt srand tan tanh wide} +set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isfinite isinf isnan isnormal isqrt issubnormal isunordered log log10 max min pow rand round sin sinh sqrt srand tan tanh wide} # Check whether the extra testing functions are defined... if {!([catch {expr T1()} msg] && ($msg eq {invalid command name "tcl::mathfunc::T1"}))} { set functions "T1 T2 T3 $functions" ;# A lazy way of prepending! -- cgit v0.12 From 6420ec98e8c9a4413ffc05b9b62892cee736e76e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 11 Jun 2019 15:30:27 +0000 Subject: Fix [25deec4e46]: Tcl fails to compile with icc due to typedef conflict --- generic/tclInt.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 821a39f..8b4ccc5 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -49,7 +49,7 @@ #include #endif #if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \ - || defined(__cplusplus) || defined(_MSC_VER) + || defined(__cplusplus) || defined(_MSC_VER) || defined(__ICC) #include #else typedef int ptrdiff_t; -- cgit v0.12 From 19d8ff62c56686e2c07979778a64661229c62a64 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 12 Jun 2019 15:26:27 +0000 Subject: Eliminate (internal) TclOffset() usage, just use offsetof() in stead. --- generic/tclBasic.c | 4 ++-- generic/tclBinary.c | 2 +- generic/tclCkalloc.c | 2 +- generic/tclCompile.c | 2 +- generic/tclExecute.c | 2 +- generic/tclHash.c | 2 +- generic/tclIO.h | 2 +- generic/tclInt.h | 15 ++++++++------- generic/tclOOMethod.c | 2 +- generic/tclProc.c | 2 +- generic/tclTest.c | 2 +- generic/tclTrace.c | 6 +++--- generic/tclVar.c | 2 +- 13 files changed, 23 insertions(+), 22 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d7eaf80..5d764e2 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -600,8 +600,8 @@ Tcl_CreateInterp(void) /*NOTREACHED*/ Tcl_Panic(" is not compatible with MSVC"); } - if ((TclOffset(Tcl_StatBuf,st_atime) != 32) - || (TclOffset(Tcl_StatBuf,st_ctime) != 40)) { + if ((offsetof(Tcl_StatBuf,st_atime) != 32) + || (offsetof(Tcl_StatBuf,st_ctime) != 40)) { /*NOTREACHED*/ Tcl_Panic(" is not compatible with MSVC"); } diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 831a427..d8b9ae9 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -277,7 +277,7 @@ typedef struct ByteArray { } ByteArray; #define BYTEARRAY_SIZE(len) \ - ((unsigned) (TclOffset(ByteArray, bytes) + (len))) + (offsetof(ByteArray, bytes) + (len)) #define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1) #define SET_BYTEARRAY(irPtr, baPtr) \ (irPtr)->twoPtrValue.ptr1 = (void *) (baPtr) diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 94327b5..d60633b 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -41,7 +41,7 @@ typedef struct MemTag { * last field in the structure. */ } MemTag; -#define TAG_SIZE(bytesInString) ((TclOffset(MemTag, string) + 1) + bytesInString) +#define TAG_SIZE(bytesInString) ((offsetof(MemTag, string) + 1) + bytesInString) static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set * by "memory tag" command). */ diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c53d3ad..0afa9cb 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -3030,7 +3030,7 @@ TclFindCompiledLocal( if (create || (name == NULL)) { localVar = procPtr->numCompiledLocals; - localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameBytes + 1); + localPtr = ckalloc(offsetof(CompiledLocal, name) + nameBytes + 1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 6b69d97..8785d36 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -211,7 +211,7 @@ typedef struct TEBCdata { */ #define VarHashGetValue(hPtr) \ - ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) + ((Var *) ((char *)hPtr - offsetof(VarInHash, entry))) static inline Var * VarHashCreateVar( diff --git a/generic/tclHash.c b/generic/tclHash.c index 6c21c59..9b462d9 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -809,7 +809,7 @@ AllocStringEntry( if (size < sizeof(hPtr->key)) { allocsize = sizeof(hPtr->key); } - hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize); + hPtr = ckalloc(offsetof(Tcl_HashEntry, key) + allocsize); memcpy(hPtr->key.string, string, size); hPtr->clientData = 0; return hPtr; diff --git a/generic/tclIO.h b/generic/tclIO.h index 15f0f78..d10f268 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -50,7 +50,7 @@ typedef struct ChannelBuffer { * structure. */ } ChannelBuffer; -#define CHANNELBUFFER_HEADER_SIZE TclOffset(ChannelBuffer, buf) +#define CHANNELBUFFER_HEADER_SIZE offsetof(ChannelBuffer, buf) /* * How much extra space to allocate in buffer to hold bytes from previous diff --git a/generic/tclInt.h b/generic/tclInt.h index e853f08..c844cc4 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4868,15 +4868,16 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; #endif /* - * ---------------------------------------------------------------------- - * Macro to use to find the offset of a field in a structure. Computes number - * of bytes from beginning of structure to a given field. + * Macro to use to find the offset of a field in astructure. + * Computes number of bytes from beginning of structure to a given field. */ -#ifdef offsetof -#define TclOffset(type, field) ((int) offsetof(type, field)) -#else -#define TclOffset(type, field) ((int) ((char *) &((type *) 0)->field)) +#ifndef TCL_NO_DEPRECATED +# define TclOffset(type, field) ((int) offsetof(type, field)) +#endif +/* Workaround for platforms missing offsetof(), e.g. VC++ 6.0 */ +#ifndef offsetof +# define offsetof(type, field) ((size_t) ((char *) &((type *) 0)->field)) #endif /* diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index db31795..32dd3c7 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -121,7 +121,7 @@ static const Tcl_MethodType fwdMethodType = { #define TclVarTable(contextNs) \ ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable)) #define TclVarHashGetValue(hPtr) \ - ((Tcl_Var) ((char *)hPtr - TclOffset(VarInHash, entry))) + ((Tcl_Var) ((char *)hPtr - offsetof(VarInHash, entry))) /* * ---------------------------------------------------------------------- diff --git a/generic/tclProc.c b/generic/tclProc.c index f24dae8..afa00ee 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -634,7 +634,7 @@ TclCreateProc( * local variables for the argument. */ - localPtr = ckalloc(TclOffset(CompiledLocal, name) + fieldValues[0]->length +1); + localPtr = ckalloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { diff --git a/generic/tclTest.c b/generic/tclTest.c index 8474a91..4eb8519 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -7710,7 +7710,7 @@ MyCompiledVarFree( } #define TclVarHashGetValue(hPtr) \ - ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) + ((Var *) ((char *)hPtr - offsetof(VarInHash, entry))) static Tcl_Var MyCompiledVarFetch( diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 20fa7e7..1a6d459 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -470,7 +470,7 @@ TraceExecutionObjCmd( length = (size_t) commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { TraceCommandInfo *tcmdPtr = ckalloc( - TclOffset(TraceCommandInfo, command) + 1 + length); + offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; tcmdPtr->stepTrace = NULL; @@ -707,7 +707,7 @@ TraceCommandObjCmd( length = (size_t) commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { TraceCommandInfo *tcmdPtr = ckalloc( - TclOffset(TraceCommandInfo, command) + 1 + length); + offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; tcmdPtr->stepTrace = NULL; @@ -910,7 +910,7 @@ TraceVariableObjCmd( length = (size_t) commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { CombinedTraceVarInfo *ctvarPtr = ckalloc( - TclOffset(CombinedTraceVarInfo, traceCmdInfo.command) + offsetof(CombinedTraceVarInfo, traceCmdInfo.command) + 1 + length); ctvarPtr->traceCmdInfo.flags = flags; diff --git a/generic/tclVar.c b/generic/tclVar.c index e400369..e8ebd3c 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -45,7 +45,7 @@ static inline Var * VarHashNextVar(Tcl_HashSearch *searchPtr); static inline void CleanupVar(Var *varPtr, Var *arrayPtr); #define VarHashGetValue(hPtr) \ - ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) + ((Var *) ((char *)hPtr - offsetof(VarInHash, entry))) /* * NOTE: VarHashCreateVar increments the recount of its key argument. -- cgit v0.12 From 5645bb01ffdfc76dbf7e9a026cb146f3d7b5eafc Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Jun 2019 17:20:45 +0000 Subject: Test namespace-56.4 detects Bug 8b9854c3d8. Branch open to fix it. --- tests/namespace.test | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/tests/namespace.test b/tests/namespace.test index 1d26512..58d6839 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3323,6 +3323,19 @@ namespace eval : { : p1 } 16fe1b5807 + +test namespace-56.4 {Bug 8b9854c3d8} -setup { + namespace eval namespace-56.4 { + proc cmd {} {string match ::* [lindex [info level 0] 0]} + namespace export * + namespace ensemble create + } +} -body { + namespace-56.4 cmd +} -cleanup { + namespace delete namespace-56.4 +} -result 1 + # cleanup catch {rename cmd1 {}} -- cgit v0.12 From 1cd98b93bd922cc624acf57f7547984606f4f565 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Jun 2019 17:37:46 +0000 Subject: Unique test name. --- tests/namespace.test | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/namespace.test b/tests/namespace.test index 58d6839..eef2eb7 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3324,16 +3324,16 @@ namespace eval : { : p1 } 16fe1b5807 -test namespace-56.4 {Bug 8b9854c3d8} -setup { - namespace eval namespace-56.4 { - proc cmd {} {string match ::* [lindex [info level 0] 0]} +test namespace-56.5 {Bug 8b9854c3d8} -setup { + namespace eval namespace-56.5 { + proc cmd {} {string match ::* [lindex [[string cat info] level 0] 0]} namespace export * namespace ensemble create } } -body { - namespace-56.4 cmd + namespace-56.5 cmd } -cleanup { - namespace delete namespace-56.4 + namespace delete namespace-56.5 } -result 1 -- cgit v0.12 From 1ebe878444abb6e6e9a919c99e6f1736353917ef Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Jun 2019 17:58:48 +0000 Subject: Fix Bug 8b9854c3d8. Now 4 test failures require examination. --- generic/tclEnsemble.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index dfffe12..3352d1f 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2694,7 +2694,11 @@ BuildEnsembleConfig( if (isNew) { Tcl_Obj *cmdObj, *cmdPrefixObj; - cmdObj = Tcl_NewStringObj(nsCmdName, -1); + TclNewObj(cmdObj); + Tcl_AppendStringsToObj(cmdObj, + ensemblePtr->nsPtr->fullName, + (ensemblePtr->nsPtr->parentPtr ? "::" : ""), + nsCmdName, NULL); cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); Tcl_SetHashValue(hPtr, cmdPrefixObj); Tcl_IncrRefCount(cmdPrefixObj); -- cgit v0.12 From 526c432322c2df709ecad50d5450141e8c883fa8 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Jun 2019 20:43:04 +0000 Subject: Mark test namespace-54.6 as knownBug. The real bug here is Tcl's failure to forbid ":" as a namespace name. --- tests/namespace.test | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/namespace.test b/tests/namespace.test index eef2eb7..ad82abe 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -1797,7 +1797,7 @@ test namespace-42.7 {ensembles: nested} -body { list [ns x0 z] [ns x1] [ns x2] [ns x3] } -cleanup { namespace delete ns -} -result {{1 z} 1 2 3} +} -result {{1 ::ns::x0::z} 1 2 3} test namespace-42.8 { ensembles: [Bug 1670091], panic due to pointer to a deallocated List struct. @@ -2128,7 +2128,7 @@ test namespace-47.1 {ensemble: unknown handler} { lappend result [catch {ns c d e} msg] $msg lappend result [catch {ns Magic foo bar spong wibble} msg] $msg list $result [lsort [info commands ::ns::*]] $log [namespace delete ns] -} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running a b c} {running a b c} {making b} {running b c d} {making c} {running c d e} {unknown Magic - args = foo bar spong wibble}} {}} +} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ::ns::a b c} {running ::ns::a b c} {making b} {running ::ns::b c d} {making c} {running ::ns::c d e} {unknown Magic - args = foo bar spong wibble}} {}} test namespace-47.2 {ensemble: unknown handler} { namespace eval ns { namespace export {[a-z]*} @@ -3227,7 +3227,7 @@ test namespace-53.10 {ensembles: nested rewrite} -setup { 1 {wrong # args: should be "ns z1 x a1"}\ 1 {wrong # args: should be "ns z2 x a1 a2"}\ 1 {wrong # args: should be "ns z2 x a1 a2"}\ - 1 {wrong # args: should be "z0"}\ + 1 {wrong # args: should be "::ns::x::z0"}\ 0 {1 v}\ 1 {wrong # args: should be "ns v x z2 a2"}\ 0 {2 v v2}} @@ -3312,7 +3312,7 @@ test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} { } } {::testing::abc::def ::testing::abc::ghi} -test namespace-56.4 {bug 16fe1b5807: names starting with ":"} { +test namespace-56.4 {bug 16fe1b5807: names starting with ":"} knownBug { namespace eval : { namespace ensemble create namespace export * -- cgit v0.12 From 475b6678272de33930144b7f27b4354095b86c6f Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 15 Jun 2019 11:56:44 +0000 Subject: Corrections to definitions of [binary scan] and [binary format]. --- doc/binary.n | 502 ++++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 342 insertions(+), 160 deletions(-) diff --git a/doc/binary.n b/doc/binary.n index 5f25d65..77a4ec2 100644 --- a/doc/binary.n +++ b/doc/binary.n @@ -12,12 +12,10 @@ .SH NAME binary \- Insert and extract fields from binary strings .SH SYNOPSIS -.VS 8.6 \fBbinary decode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR .br \fBbinary encode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR .br -.VE 8.6 \fBbinary format \fIformatString \fR?\fIarg arg ...\fR? .br \fBbinary scan \fIstring formatString \fR?\fIvarName varName ...\fR? @@ -31,11 +29,9 @@ architecture, it might produce an 8-byte binary string consisting of two 4-byte integers, one for each of the numbers. The subcommand \fBbinary scan\fR, does the opposite: it extracts data from a binary string and returns it as ordinary Tcl string values. -.VS 8.6 The \fBbinary encode\fR and \fBbinary decode\fR subcommands convert binary data to or from string encodings such as base64 (used in MIME messages for example). -.VE 8.6 .PP Note that other operations on binary data, such as taking a subsequence of it, getting its length, or reinterpreting it as a string in some encoding, are @@ -44,7 +40,6 @@ done by other Tcl commands (respectively \fBstring range\fR, binary string in Tcl is merely one where all the characters it contains are in the range \eu0000\-\eu00FF. .SH "BINARY ENCODE AND DECODE" -.VS 8.6 .PP When encoding binary data as a readable string, the starting binary data is passed to the \fBbinary encode\fR command, together with the name of the @@ -128,7 +123,6 @@ characters. Otherwise it ignores them. Note that neither the encoder nor the decoder handle the header and footer of the uuencode format. .RE -.VE 8.6 .SH "BINARY FORMAT" .PP The \fBbinary format\fR command generates a binary string whose layout @@ -143,7 +137,9 @@ Most field specifiers consume one argument to obtain the value to be formatted. The type character specifies how the value is to be formatted. The \fIcount\fR typically indicates how many items of the specified type are taken from the value. If present, the \fIcount\fR -is a non-negative decimal integer or \fB*\fR, which normally indicates +is a non-negative decimal integer or +.QW \fB*\fR , +which normally indicates that all of the items in the value are to be used. If the number of arguments does not match the number of fields in the format string that consume arguments, then an error is generated. The flag character @@ -151,6 +147,7 @@ is ignored for \fBbinary format\fR. .PP Here is a small example to clarify the relation between the field specifiers and the arguments: +.PP .CS \fBbinary format\fR d3d {1.0 2.0 3.0 4.0} 0.1 .CE @@ -178,72 +175,126 @@ not part of the ISO 8859\-1 character set.) If \fIarg\fR has fewer than \fIcount\fR bytes, then additional zero bytes are used to pad out the field. If \fIarg\fR is longer than the specified length, the extra characters will be ignored. If -\fIcount\fR is \fB*\fR, then all of the bytes in \fIarg\fR will be +\fIcount\fR is +.QW \fB*\fR , +then all of the bytes in \fIarg\fR will be formatted. If \fIcount\fR is omitted, then one character will be -formatted. For example, -.RS +formatted. For example, the command: +.RS +.PP .CS \fBbinary format\fR a7a*a alpha bravo charlie +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fBalpha\e000\e000bravoc\fR .CE -will return a string equivalent to \fBalpha\e000\e000bravoc\fR, +.PP +the command: +.PP .CS \fBbinary format\fR a* [encoding convertto utf-8 \eu20ac] +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fB\e342\e202\e254\fR .CE -will return a string equivalent to \fB\e342\e202\e254\fR (which is the -UTF-8 byte sequence for a Euro-currency character) and +.PP +(which is the +UTF-8 byte sequence for a Euro-currency character), and the command: +.PP .CS \fBbinary format\fR a* [encoding convertto iso8859-15 \eu20ac] +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fB\e244\fR .CE -will return a string equivalent to \fB\e244\fR (which is the ISO +.PP +(which is the ISO 8859\-15 byte sequence for a Euro-currency character). Contrast these -last two with: +last two with: +.PP .CS \fBbinary format\fR a* \eu20ac +.CE +.PP +which returns a binary string equivalent to: +.PP +.CS +\fB\e254\fR .CE -which returns a string equivalent to \fB\e254\fR (i.e. \fB\exac\fR) by +.PP +(i.e. \fB\exac\fR) by truncating the high-bits of the character, and which is probably not what is desired. .RE .IP \fBA\fR 5 This form is the same as \fBa\fR except that spaces are used for padding instead of nulls. For example, -.RS +.RS +.PP .CS \fBbinary format\fR A6A*A alpha bravo charlie +.CE +.PP +will return +.PP +.CS +\fBalpha bravoc\fR .CE -will return \fBalpha bravoc\fR. .RE .IP \fBb\fR 5 Stores a string of \fIcount\fR binary digits in low-to-high order -within each byte in the output string. \fIArg\fR must contain a +within each byte in the output binary string. \fIArg\fR must contain a sequence of \fB1\fR and \fB0\fR characters. The resulting bytes are emitted in first to last order with the bits being formatted in low-to-high order within each byte. If \fIarg\fR has fewer than \fIcount\fR digits, then zeros will be used for the remaining bits. If \fIarg\fR has more than the specified number of digits, the extra -digits will be ignored. If \fIcount\fR is \fB*\fR, then all of the +digits will be ignored. If \fIcount\fR is +.QW \fB*\fR , +then all of the digits in \fIarg\fR will be formatted. If \fIcount\fR is omitted, then one digit will be formatted. If the number of bits formatted does not end at a byte boundary, the remaining bits of the last byte will be zeros. For example, -.RS +.RS +.PP .CS \fBbinary format\fR b5b* 11100 111000011010 +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fB\ex07\ex87\ex05\fR .CE -will return a string equivalent to \fB\ex07\ex87\ex05\fR. .RE .IP \fBB\fR 5 This form is the same as \fBb\fR except that the bits are stored in high-to-low order within each byte. For example, -.RS +.RS +.PP .CS \fBbinary format\fR B5B* 11100 111000011010 +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fB\exe0\exe1\exa0\fR .CE -will return a string equivalent to \fB\exe0\exe1\exa0\fR. .RE .IP \fBH\fR 5 Stores a string of \fIcount\fR hexadecimal digits in high-to-low -within each byte in the output string. \fIArg\fR must contain a +within each byte in the output binary string. \fIArg\fR must contain a sequence of characters in the set .QW 0123456789abcdefABCDEF . The resulting bytes are emitted in first to last order with the hex digits @@ -251,43 +302,66 @@ being formatted in high-to-low order within each byte. If \fIarg\fR has fewer than \fIcount\fR digits, then zeros will be used for the remaining digits. If \fIarg\fR has more than the specified number of digits, the extra digits will be ignored. If \fIcount\fR is -\fB*\fR, then all of the digits in \fIarg\fR will be formatted. If +.QW \fB*\fR , +then all of the digits in \fIarg\fR will be formatted. If \fIcount\fR is omitted, then one digit will be formatted. If the number of digits formatted does not end at a byte boundary, the remaining bits of the last byte will be zeros. For example, -.RS +.RS +.PP .CS \fBbinary format\fR H3H*H2 ab DEF 987 +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fB\exab\ex00\exde\exf0\ex98\fR .CE -will return a string equivalent to \fB\exab\ex00\exde\exf0\ex98\fR. .RE .IP \fBh\fR 5 This form is the same as \fBH\fR except that the digits are stored in low-to-high order within each byte. This is seldom required. For example, -.RS +.RS +.PP .CS \fBbinary format\fR h3h*h2 AB def 987 +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fB\exba\ex00\exed\ex0f\ex89\fR .CE -will return a string equivalent to \fB\exba\ex00\exed\ex0f\ex89\fR. .RE .IP \fBc\fR 5 Stores one or more 8-bit integer values in the output string. If no \fIcount\fR is specified, then \fIarg\fR must consist of an integer value. If \fIcount\fR is specified, \fIarg\fR must consist of a list containing at least that many integers. The low-order 8 bits of each integer -are stored as a one-byte value at the cursor position. If \fIcount\fR -is \fB*\fR, then all of the integers in the list are formatted. If the +are stored as a one-byte value at the cursor position. If \fIcount\fR is +.QW \fB*\fR , +then all of the integers in the list are formatted. If the number of elements in the list is greater than \fIcount\fR, then the extra elements are ignored. For example, -.RS +.RS +.PP .CS \fBbinary format\fR c3cc* {3 -3 128 1} 260 {2 5} +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR .CE -will return a string equivalent to -\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR, whereas +.PP +whereas: +.PP .CS \fBbinary format\fR c {2 5} -.CE +.CE +.PP will generate an error. .RE .IP \fBs\fR 5 @@ -296,23 +370,33 @@ This form is the same as \fBc\fR except that it stores one or more low-order 16-bits of each integer are stored as a two-byte value at the cursor position with the least significant byte stored first. For example, -.RS +.RS +.PP .CS \fBbinary format\fR s3 {3 -3 258 1} +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fB\ex03\ex00\exfd\exff\ex02\ex01\fR .CE -will return a string equivalent to -\fB\ex03\ex00\exfd\exff\ex02\ex01\fR. .RE .IP \fBS\fR 5 This form is the same as \fBs\fR except that it stores one or more 16-bit integers in big-endian byte order in the output string. For example, -.RS +.RS +.PP .CS \fBbinary format\fR S3 {3 -3 258 1} +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fB\ex00\ex03\exff\exfd\ex01\ex02\fR .CE -will return a string equivalent to -\fB\ex00\ex03\exff\exfd\ex01\ex02\fR. .RE .IP \fBt\fR 5 This form (mnemonically \fItiny\fR) is the same as \fBs\fR and \fBS\fR @@ -326,23 +410,33 @@ This form is the same as \fBc\fR except that it stores one or more low-order 32-bits of each integer are stored as a four-byte value at the cursor position with the least significant byte stored first. For example, -.RS +.RS +.PP .CS \fBbinary format\fR i3 {3 -3 65536 1} -.CE -will return a string equivalent to +.CE +.PP +will return a binary string equivalent to: +.PP +.CS \fB\ex03\ex00\ex00\ex00\exfd\exff\exff\exff\ex00\ex00\ex01\ex00\fR +.CE .RE .IP \fBI\fR 5 This form is the same as \fBi\fR except that it stores one or more one or more 32-bit integers in big-endian byte order in the output string. For example, -.RS +.RS +.PP .CS \fBbinary format\fR I3 {3 -3 65536 1} -.CE -will return a string equivalent to +.CE +.PP +will return a binary string equivalent to: +.PP +.CS \fB\ex00\ex00\ex00\ex03\exff\exff\exff\exfd\ex00\ex01\ex00\ex00\fR +.CE .RE .IP \fBn\fR 5 This form (mnemonically \fInumber\fR or \fInormal\fR) is the same as @@ -357,21 +451,25 @@ This form is the same as \fBc\fR except that it stores one or more low-order 64-bits of each integer are stored as an eight-byte value at the cursor position with the least significant byte stored first. For example, -.RS +.RS +.PP .CS \fBbinary format\fR w 7810179016327718216 -.CE -will return the string \fBHelloTcl\fR +.CE +.PP +will return the binary string \fBHelloTcl\fR. .RE .IP \fBW\fR 5 This form is the same as \fBw\fR except that it stores one or more one or more 64-bit integers in big-endian byte order in the output string. For example, -.RS +.RS +.PP .CS \fBbinary format\fR Wc 4785469626960341345 110 -.CE -will return the string \fBBigEndian\fR +.CE +.PP +will return the binary string \fBBigEndian\fR .RE .IP \fBm\fR 5 This form (mnemonically the mirror of \fBw\fR) is the same as \fBw\fR @@ -393,12 +491,17 @@ as defined by the system will be used instead. Because Tcl uses double-precision floating point numbers internally, there may be some loss of precision in the conversion to single-precision. For example, on a Windows system running on an Intel Pentium processor, -.RS +.RS +.PP .CS \fBbinary format\fR f2 {1.6 3.4} +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR .CE -will return a string equivalent to -\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR. .RE .IP \fBr\fR 5 This form (mnemonically \fIreal\fR) is the same as \fBf\fR except that @@ -414,12 +517,17 @@ This form is the same as \fBf\fR except that it stores one or more one or more double-precision floating point numbers in the machine's native representation in the output string. For example, on a Windows system running on an Intel Pentium processor, -.RS +.RS +.PP .CS \fBbinary format\fR d1 {1.6} +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR .CE -will return a string equivalent to -\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR. .RE .IP \fBq\fR 5 This form (mnemonically the mirror of \fBd\fR) is the same as \fBd\fR @@ -432,26 +540,37 @@ This form is the same as \fBq\fR except that it stores the double-precision floating point numbers in big-endian order. .IP \fBx\fR 5 Stores \fIcount\fR null bytes in the output string. If \fIcount\fR is -not specified, stores one null byte. If \fIcount\fR is \fB*\fR, +not specified, stores one null byte. If \fIcount\fR is +.QW \fB*\fR , generates an error. This type does not consume an argument. For example, -.RS +.RS +.PP .CS \fBbinary format\fR a3xa3x2a3 abc def ghi +.CE +.PP +will return a binary string equivalent to: +.PP +.CS +\fBabc\e000def\e000\e000ghi\fR .CE -will return a string equivalent to \fBabc\e000def\e000\e000ghi\fR. .RE .IP \fBX\fR 5 Moves the cursor back \fIcount\fR bytes in the output string. If -\fIcount\fR is \fB*\fR or is larger than the current cursor position, +\fIcount\fR is +.QW \fB*\fR +or is larger than the current cursor position, then the cursor is positioned at location 0 so that the next byte stored will be the first byte in the result string. If \fIcount\fR is omitted then the cursor is moved back one byte. This type does not consume an argument. For example, -.RS +.RS +.PP .CS \fBbinary format\fR a3X*a3X2a3 abc def ghi -.CE +.CE +.PP will return \fBdghi\fR. .RE .IP \fB@\fR 5 @@ -460,14 +579,22 @@ specified by \fIcount\fR. Position 0 refers to the first byte in the output string. If \fIcount\fR refers to a position beyond the last byte stored so far, then null bytes will be placed in the uninitialized locations and the cursor will be placed at the specified location. If -\fIcount\fR is \fB*\fR, then the cursor is moved to the current end of +\fIcount\fR is +.QW \fB*\fR , +then the cursor is moved to the current end of the output string. If \fIcount\fR is omitted, then an error will be generated. This type does not consume an argument. For example, -.RS +.RS +.PP .CS \fBbinary format\fR a5@2a1@*a3@10a1 abcde f ghi j +.CE +.PP +will return +.PP +.CS +\fBabfdeghi\e000\e000j\fR .CE -will return \fBabfdeghi\e000\e000j\fR. .RE .SH "BINARY SCAN" .PP @@ -489,8 +616,9 @@ argument to obtain the variable into which the scanned values should be placed. The type character specifies how the binary data is to be interpreted. The \fIcount\fR typically indicates how many items of the specified type are taken from the data. If present, the -\fIcount\fR is a non-negative decimal integer or \fB*\fR, which -normally indicates that all of the remaining items in the data are to +\fIcount\fR is a non-negative decimal integer or +.QW \fB*\fR , +which normally indicates that all of the remaining items in the data are to be used. If there are not enough bytes left after the current cursor position to satisfy the current field specifier, then the corresponding variable is left untouched and \fBbinary scan\fR returns @@ -503,7 +631,8 @@ is accepted for all field types but is ignored for non-integer fields. .PP A similar example as with \fBbinary format\fR should explain the relation between field specifiers and arguments in case of the binary -scan subcommand: +scan subcommand: +.PP .CS \fBbinary scan\fR $bytes s3s first second .CE @@ -514,13 +643,16 @@ is long enough) assigns a list of three integers to the variable If \fIbytes\fR contains fewer than 8 bytes (i.e. four 2-byte integers), no assignment to \fIsecond\fR will be made, and if \fIbytes\fR contains fewer than 6 bytes (i.e. three 2-byte integers), -no assignment to \fIfirst\fR will be made. Hence: +no assignment to \fIfirst\fR will be made. Hence: +.PP .CS puts [\fBbinary scan\fR abcdefg s3s first second] puts $first puts $second -.CE -will print (assuming neither variable is set previously): +.CE +.PP +will print (assuming neither variable is set previously): +.PP .CS 1 25185 25699 26213 @@ -531,15 +663,18 @@ It is \fIimportant\fR to note that the \fBc\fR, \fBs\fR, and \fBS\fR (and \fBi\fR and \fBI\fR on 64bit systems) will be scanned into long data size values. In doing this, values that have their high bit set (0x80 for chars, 0x8000 for shorts, 0x80000000 for ints), -will be sign extended. Thus the following will occur: +will be sign extended. Thus the following will occur: +.PP .CS set signShort [\fBbinary format\fR s1 0x8000] \fBbinary scan\fR $signShort s1 val; \fI# val == 0xFFFF8000\fR -.CE +.CE +.PP If you require unsigned values you can include the .QW u flag character following -the field type. For example, to read an unsigned short value: +the field type. For example, to read an unsigned short value: +.PP .CS set signShort [\fBbinary format\fR s1 0x8000] \fBbinary scan\fR $signShort su1 val; \fI# val == 0x00008000\fR @@ -550,8 +685,9 @@ reading bytes from the current position. The cursor is initially at position 0 at the beginning of the data. The type may be any one of the following characters: .IP \fBa\fR 5 -The data is a byte string of length \fIcount\fR. If \fIcount\fR -is \fB*\fR, then all of the remaining bytes in \fIstring\fR will be +The data is a byte string of length \fIcount\fR. If \fIcount\fR is +.QW \fB*\fR , +then all of the remaining bytes in \fIstring\fR will be scanned into the variable. If \fIcount\fR is omitted, then one byte will be scanned. All bytes scanned will be interpreted as being characters in the @@ -559,25 +695,31 @@ range \eu0000-\eu00ff so the \fBencoding convertfrom\fR command will be needed if the string is not a binary string or a string encoded in ISO 8859\-1. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR abcde\e000fghi a6a10 var1 var2 -.CE +.CE +.PP will return \fB1\fR with the string equivalent to \fBabcde\e000\fR -stored in \fIvar1\fR and \fIvar2\fR left unmodified, and +stored in \fIvar1\fR and \fIvar2\fR left unmodified, and +.PP .CS \fBbinary scan\fR \e342\e202\e254 a* var1 set var2 [encoding convertfrom utf-8 $var1] -.CE +.CE +.PP will store a Euro-currency character in \fIvar2\fR. .RE .IP \fBA\fR 5 This form is the same as \fBa\fR, except trailing blanks and nulls are stripped from the scanned value before it is stored in the variable. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR "abc efghi \e000" A* var1 -.CE +.CE +.PP will return \fB1\fR with \fBabc efghi\fR stored in \fIvar1\fR. .RE .IP \fBb\fR 5 @@ -588,23 +730,28 @@ and .QW 0 characters. The data bytes are scanned in first to last order with the bits being taken in low-to-high order within each byte. Any extra -bits in the last byte are ignored. If \fIcount\fR is \fB*\fR, then -all of the remaining bits in \fIstring\fR will be scanned. If +bits in the last byte are ignored. If \fIcount\fR is +.QW \fB*\fR , +then all of the remaining bits in \fIstring\fR will be scanned. If \fIcount\fR is omitted, then one bit will be scanned. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex07\ex87\ex05 b5b* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB11100\fR stored in \fIvar1\fR and \fB1110000110100000\fR stored in \fIvar2\fR. .RE .IP \fBB\fR 5 This form is the same as \fBb\fR, except the bits are taken in high-to-low order within each byte. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex70\ex87\ex05 B5B* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB01110\fR stored in \fIvar1\fR and \fB1000011100000101\fR stored in \fIvar2\fR. .RE @@ -615,23 +762,28 @@ high-to-low order represented as a sequence of characters in the set The data bytes are scanned in first to last order with the hex digits being taken in high-to-low order within each byte. Any extra bits in the last byte are ignored. If \fIcount\fR is -\fB*\fR, then all of the remaining hex digits in \fIstring\fR will be +.QW \fB*\fR , +then all of the remaining hex digits in \fIstring\fR will be scanned. If \fIcount\fR is omitted, then one hex digit will be scanned. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and \fB051f34\fR stored in \fIvar2\fR. .RE .IP \fBh\fR 5 This form is the same as \fBH\fR, except the digits are taken in reverse (low-to-high) order within each byte. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex07\ex86\ex05\ex12\ex34 h3h* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB706\fR stored in \fIvar1\fR and \fB502143\fR stored in \fIvar2\fR. .PP @@ -640,135 +792,151 @@ multiple bytes in order should use the \fBH\fR format. .RE .IP \fBc\fR 5 The data is turned into \fIcount\fR 8-bit signed integers and stored -in the corresponding variable as a list. If \fIcount\fR is \fB*\fR, +in the corresponding variable as a list, or as unsigned if \fBu\fR is placed +immediately after the \fBc\fR. If \fIcount\fR is +.QW \fB*\fR , then all of the remaining bytes in \fIstring\fR will be scanned. If \fIcount\fR is omitted, then one 8-bit integer will be scanned. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex07\ex86\ex05 c2c* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB7 -122\fR stored in \fIvar1\fR and \fB5\fR -stored in \fIvar2\fR. Note that the integers returned are signed, but -they can be converted to unsigned 8-bit quantities using an expression -like: -.CS -set num [expr { $num & 0xff }] -.CE +stored in \fIvar2\fR. Note that the integers returned are signed unless +\fBcu\fR in place of \fBc\fR. .RE .IP \fBs\fR 5 The data is interpreted as \fIcount\fR 16-bit signed integers -represented in little-endian byte order. The integers are stored in -the corresponding variable as a list. If \fIcount\fR is \fB*\fR, then -all of the remaining bytes in \fIstring\fR will be scanned. If +represented in little-endian byte order, or as unsigned if \fBu\fR is placed +immediately after the \fBs\fR. The integers are stored in +the corresponding variable as a list. If \fIcount\fR is +.QW \fB*\fR , +then all of the remaining bytes in \fIstring\fR will be scanned. If \fIcount\fR is omitted, then one 16-bit integer will be scanned. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex05\ex00\ex07\ex00\exf0\exff s2s* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR -stored in \fIvar2\fR. Note that the integers returned are signed, but -they can be converted to unsigned 16-bit quantities using an expression -like: -.CS -set num [expr { $num & 0xffff }] -.CE +stored in \fIvar2\fR. Note that the integers returned are signed unless +\fBsu\fR is used in place of \fBs\fR. .RE .IP \fBS\fR 5 This form is the same as \fBs\fR except that the data is interpreted -as \fIcount\fR 16-bit signed integers represented in big-endian byte +as \fIcount\fR 16-bit integers represented in big-endian byte order. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR stored in \fIvar2\fR. .RE .IP \fBt\fR 5 The data is interpreted as \fIcount\fR 16-bit signed integers represented in the native byte order of the machine running the Tcl -script. It is otherwise identical to \fBs\fR and \fBS\fR. +script, or as unsigned if \fBu\fR is placed +immediately after the \fBt\fR. It is otherwise identical to \fBs\fR and \fBS\fR. To determine what the native byte order of the machine is, refer to the \fBbyteOrder\fR element of the \fBtcl_platform\fR array. .IP \fBi\fR 5 The data is interpreted as \fIcount\fR 32-bit signed integers -represented in little-endian byte order. The integers are stored in -the corresponding variable as a list. If \fIcount\fR is \fB*\fR, then -all of the remaining bytes in \fIstring\fR will be scanned. If +represented in little-endian byte order, or as unsigned if \fBu\fR is placed +immediately after the \fBi\fR. The integers are stored in +the corresponding variable as a list. If \fIcount\fR is +.QW \fB*\fR , +then all of the remaining bytes in \fIstring\fR will be scanned. If \fIcount\fR is omitted, then one 32-bit integer will be scanned. For example, -.RS +.RS +.PP .CS set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff \fBbinary scan\fR $str i2i* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR -stored in \fIvar2\fR. Note that the integers returned are signed, but -they can be converted to unsigned 32-bit quantities using an expression -like: -.CS -set num [expr { $num & 0xffffffff }] -.CE +stored in \fIvar2\fR. Note that the integers returned are signed unless +\fBiu\fR is used in place of \fBi\fR. .RE .IP \fBI\fR 5 This form is the same as \fBI\fR except that the data is interpreted as \fIcount\fR 32-bit signed integers represented in big-endian byte -order. For example, -.RS +order, or as unsigned if \fBu\fR is placed +immediately after the \fBI\fR. For example, +.RS +.PP .CS set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0 \fBbinary scan\fR $str I2I* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR stored in \fIvar2\fR. .RE .IP \fBn\fR 5 The data is interpreted as \fIcount\fR 32-bit signed integers represented in the native byte order of the machine running the Tcl -script. It is otherwise identical to \fBi\fR and \fBI\fR. +script, or as unsigned if \fBu\fR is placed +immediately after the \fBn\fR. It is otherwise identical to \fBi\fR and \fBI\fR. To determine what the native byte order of the machine is, refer to the \fBbyteOrder\fR element of the \fBtcl_platform\fR array. .IP \fBw\fR 5 The data is interpreted as \fIcount\fR 64-bit signed integers -represented in little-endian byte order. The integers are stored in -the corresponding variable as a list. If \fIcount\fR is \fB*\fR, then -all of the remaining bytes in \fIstring\fR will be scanned. If +represented in little-endian byte order, or as unsigned if \fBu\fR is placed +immediately after the \fBw\fR. The integers are stored in +the corresponding variable as a list. If \fIcount\fR is +.QW \fB*\fR , +then all of the remaining bytes in \fIstring\fR will be scanned. If \fIcount\fR is omitted, then one 64-bit integer will be scanned. For example, -.RS +.RS +.PP .CS set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff \fBbinary scan\fR $str wi* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB30064771077\fR stored in \fIvar1\fR and -\fB\-16\fR stored in \fIvar2\fR. Note that the integers returned are -signed and cannot be represented by Tcl as unsigned values. +\fB\-16\fR stored in \fIvar2\fR. .RE .IP \fBW\fR 5 This form is the same as \fBw\fR except that the data is interpreted as \fIcount\fR 64-bit signed integers represented in big-endian byte -order. For example, -.RS +order, or as unsigned if \fBu\fR is placed +immediately after the \fBW\fR. For example, +.RS +.PP .CS set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0 \fBbinary scan\fR $str WI* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB21474836487\fR stored in \fIvar1\fR and \fB\-16\fR stored in \fIvar2\fR. .RE .IP \fBm\fR 5 The data is interpreted as \fIcount\fR 64-bit signed integers represented in the native byte order of the machine running the Tcl -script. It is otherwise identical to \fBw\fR and \fBW\fR. +script, or as unsigned if \fBu\fR is placed +immediately after the \fBm\fR. It is otherwise identical to \fBw\fR and \fBW\fR. To determine what the native byte order of the machine is, refer to the \fBbyteOrder\fR element of the \fBtcl_platform\fR array. .IP \fBf\fR 5 The data is interpreted as \fIcount\fR single-precision floating point numbers in the machine's native representation. The floating point numbers are stored in the corresponding variable as a list. If -\fIcount\fR is \fB*\fR, then all of the remaining bytes in +\fIcount\fR is +.QW \fB*\fR , +then all of the remaining bytes in \fIstring\fR will be scanned. If \fIcount\fR is omitted, then one single-precision floating point number will be scanned. The size of a floating point number may vary across architectures, so the number of @@ -776,10 +944,12 @@ bytes that are scanned may vary. If the data does not represent a valid floating point number, the resulting value is undefined and compiler dependent. For example, on a Windows system running on an Intel Pentium processor, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex3f\excc\excc\excd f var1 -.CE +.CE +.PP will return \fB1\fR with \fB1.6000000238418579\fR stored in \fIvar1\fR. .RE @@ -798,10 +968,12 @@ This form is the same as \fBf\fR except that the data is interpreted as \fIcount\fR double-precision floating point numbers in the machine's native representation. For example, on a Windows system running on an Intel Pentium processor, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1 -.CE +.CE +.PP will return \fB1\fR with \fB1.6000000000000001\fR stored in \fIvar1\fR. .RE @@ -817,28 +989,36 @@ order. This conversion is not portable to the minority of systems not using IEEE floating point representations. .IP \fBx\fR 5 Moves the cursor forward \fIcount\fR bytes in \fIstring\fR. If -\fIcount\fR is \fB*\fR or is larger than the number of bytes after the +\fIcount\fR is +.QW \fB*\fR +or is larger than the number of bytes after the current cursor position, then the cursor is positioned after the last byte in \fIstring\fR. If \fIcount\fR is omitted, then the cursor is moved forward one byte. Note that this type does not consume an argument. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex01\ex02\ex03\ex04 x2H* var1 -.CE +.CE +.PP will return \fB1\fR with \fB0304\fR stored in \fIvar1\fR. .RE .IP \fBX\fR 5 Moves the cursor back \fIcount\fR bytes in \fIstring\fR. If -\fIcount\fR is \fB*\fR or is larger than the current cursor position, +\fIcount\fR is +.QW \fB*\fR +or is larger than the current cursor position, then the cursor is positioned at location 0 so that the next byte scanned will be the first byte in \fIstring\fR. If \fIcount\fR is omitted then the cursor is moved back one byte. Note that this type does not consume an argument. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex01\ex02\ex03\ex04 c2XH* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB1 2\fR stored in \fIvar1\fR and \fB020304\fR stored in \fIvar2\fR. .RE @@ -848,10 +1028,12 @@ by \fIcount\fR. Note that position 0 refers to the first byte in \fIstring\fR. If \fIcount\fR refers to a position beyond the end of \fIstring\fR, then the cursor is positioned after the last byte. If \fIcount\fR is omitted, then an error will be generated. For example, -.RS +.RS +.PP .CS \fBbinary scan\fR \ex01\ex02\ex03\ex04 c2@1H* var1 var2 -.CE +.CE +.PP will return \fB2\fR with \fB1 2\fR stored in \fIvar1\fR and \fB020304\fR stored in \fIvar2\fR. .RE -- cgit v0.12 From 4e87d51f9d08a4cefa1b51425f990bcd22b2cbf1 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 15 Jun 2019 21:03:08 +0000 Subject: Try to work around MSVC6's lack of fpclassify()... --- generic/tclBasic.c | 59 +++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 50 insertions(+), 9 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d11411d..22c8113 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -23,6 +23,9 @@ #include "tommath.h" #include #include +#if defined(_MSC_VER) && (_MSC_VER <= 1200) +#include +#endif /* defined(_MSC_VER) && (_MSC_VER <= 1200) */ #define INTERP_STACK_INITIAL_SIZE 2000 #define CORO_STACK_INITIAL_SIZE 200 @@ -8316,6 +8319,44 @@ ExprSrandFunc( *---------------------------------------------------------------------- */ +static inline int +ClassifyDouble( + double d) +{ +#if defined(_MSC_VER) && (_MSC_VER <= 1200) + /* + * MSVC6 is supported by Tcl, but doesn't have fpclassify(). Of course. + */ +#define FP_ZERO 0 +#define FP_NORMAL 1 +#define FP_SUBNORMAL 2 +#define FP_INFINITE 3 +#define FP_NAN 4 + + switch (_fpclass(d)) { + case _FPCLASS_NZ: + case _FPCLASS_PZ: + return FP_ZERO; + case _FPCLASS_NN: + case _FPCLASS_PN: + return FP_NORMAL; + case _FPCLASS_ND: + case _FPCLASS_PD: + return FP_SUBNORMAL; + case _FPCLASS_NINF: + case _FPCLASS_PINF: + return FP_INFINITE; + default: + Tcl_Panic("result of _fpclass() outside documented range!"); + case _FPCLASS_QNAN: + case _FPCLASS_SNAN: + return FP_NAN; + } +#else /* !defined(_MSC_VER) || (_MSC_VER > 1200) */ + return fpclassify(d); +#endif /* defined(_MSC_VER) && (_MSC_VER <= 1200) */ +} + static int ExprIsFiniteFunc( ClientData ignored, @@ -8340,7 +8381,7 @@ ExprIsFiniteFunc( if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { return TCL_ERROR; } - type = fpclassify(d); + type = ClassifyDouble(d); result = (type != FP_INFINITE && type != FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); @@ -8371,7 +8412,7 @@ ExprIsInfinityFunc( if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { return TCL_ERROR; } - result = (fpclassify(d) == FP_INFINITE); + result = (ClassifyDouble(d) == FP_INFINITE); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8401,7 +8442,7 @@ ExprIsNaNFunc( if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { return TCL_ERROR; } - result = (fpclassify(d) == FP_NAN); + result = (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8431,7 +8472,7 @@ ExprIsNormalFunc( if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { return TCL_ERROR; } - result = (fpclassify(d) == FP_NORMAL); + result = (ClassifyDouble(d) == FP_NORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8461,7 +8502,7 @@ ExprIsSubnormalFunc( if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { return TCL_ERROR; } - result = (fpclassify(d) == FP_SUBNORMAL); + result = (ClassifyDouble(d) == FP_SUBNORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8491,17 +8532,17 @@ ExprIsUnorderedFunc( result = 1; } else { d = *((const double *) ptr); - result |= isnan(d); + result = (ClassifyDouble(d) == FP_NAN); } if (TclGetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) { return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result = 1; + result |= 1; } else { d = *((const double *) ptr); - result |= isnan(d); + result |= (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); @@ -8534,7 +8575,7 @@ FloatClassifyObjCmd( } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { return TCL_ERROR; } - switch (fpclassify(d)) { + switch (ClassifyDouble(d)) { case FP_INFINITE: TclNewLiteralStringObj(objPtr, "infinite"); break; -- cgit v0.12 From 7a638ab80dac51d94a780ddb69586d05083c8a93 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 15 Jun 2019 21:24:36 +0000 Subject: A neater way to write it that doesn't depend on detecting a specfic compiler version. For now. --- generic/tclBasic.c | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 22c8113..316a87d 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -23,9 +23,9 @@ #include "tommath.h" #include #include -#if defined(_MSC_VER) && (_MSC_VER <= 1200) +#ifndef fpclassify /* Older MSVC */ #include -#endif /* defined(_MSC_VER) && (_MSC_VER <= 1200) */ +#endif /* !fpclassify */ #define INTERP_STACK_INITIAL_SIZE 2000 #define CORO_STACK_INITIAL_SIZE 200 @@ -8319,14 +8319,21 @@ ExprSrandFunc( *---------------------------------------------------------------------- */ +/* + * Older MSVC is supported by Tcl, but doesn't have fpclassify(). Of course. + * But it does have _fpclass() which does almost the same job. + * + * This makes it conform to the C99 standard API, and just delegates to the + * standard macro on platforms that do it correctly. + */ + static inline int ClassifyDouble( double d) { -#if defined(_MSC_VER) && (_MSC_VER <= 1200) - /* - * MSVC6 is supported by Tcl, but doesn't have fpclassify(). Of course. - */ +#ifdef fpclassify + return fpclassify(d); +#else /* !fpclassify */ #define FP_ZERO 0 #define FP_NORMAL 1 #define FP_SUBNORMAL 2 @@ -8352,9 +8359,7 @@ ClassifyDouble( case _FPCLASS_SNAN: return FP_NAN; } -#else /* !defined(_MSC_VER) || (_MSC_VER > 1200) */ - return fpclassify(d); -#endif /* defined(_MSC_VER) && (_MSC_VER <= 1200) */ +#endif /* fpclassify */ } static int -- cgit v0.12 From c1ee80eccf07579e1df09f808369df85013241db Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 15 Jun 2019 22:30:59 +0000 Subject: Use mp_init_set() in stead of mp_init_set_int() when the constant is sufficiently small. This is slightly better optimized. --- generic/tclStrToD.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 17d630b..a93c81b 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -3263,7 +3263,7 @@ ShorteningBignumConversionPowD(Double* dPtr, */ TclBNInitBignumFromWideUInt(&b, bw); - mp_init_set_int(&mminus, 1); + mp_init_set(&mminus, 1); MulPow5(&b, b5, &b); mp_mul_2d(&b, b2, &b); @@ -3666,7 +3666,7 @@ ShorteningBignumConversion(Double* dPtr, TclBNInitBignumFromWideUInt(&b, bw); mp_mul_2d(&b, b2, &b); - mp_init_set_int(&S, 1); + mp_init_set(&S, 1); MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S); /* @@ -3683,7 +3683,7 @@ ShorteningBignumConversion(Double* dPtr, /* mminus = 2**m2minus * 5**m5 */ - mp_init_set_int(&mminus, minit); + mp_init_set(&mminus, minit); mp_mul_2d(&mminus, m2minus, &mminus); if (m2plus > m2minus) { mp_init_copy(&mplus, &mminus); @@ -3879,7 +3879,7 @@ StrictBignumConversion(Double* dPtr, mp_init_multi(&temp, &dig, NULL); TclBNInitBignumFromWideUInt(&b, bw); mp_mul_2d(&b, b2, &b); - mp_init_set_int(&S, 1); + mp_init_set(&S, 1); MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S); /* -- cgit v0.12 From 2f8cb2ab854a2e311b49c8276bb59a76adaeafeb Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 20 Jun 2019 19:40:30 +0000 Subject: [6bdadfba7d] Stop crash with multi-lappend and failing writes --- generic/tclExecute.c | 21 +++++++++++++-------- tests/execute.test | 39 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 52 insertions(+), 8 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index bf2d7bc..413c753 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3716,31 +3716,36 @@ TEBCresume( { int createdNewObj = 0; + Tcl_Obj *valueToAssign; if (!objResultPtr) { - objResultPtr = valuePtr; + valueToAssign = valuePtr; } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) { TRACE_ERROR(interp); goto gotError; } else { if (Tcl_IsShared(objResultPtr)) { - objResultPtr = Tcl_DuplicateObj(objResultPtr); + valueToAssign = Tcl_DuplicateObj(objResultPtr); createdNewObj = 1; + } else { + valueToAssign = objResultPtr; } - if (Tcl_ListObjReplace(interp, objResultPtr, len,0, objc,objv) - != TCL_OK) { + if (Tcl_ListObjReplace(interp, valueToAssign, len, 0, + objc, objv) != TCL_OK) { + if (createdNewObj) { + TclDecrRefCount(valueToAssign); + } goto errorInLappendListPtr; } } DECACHE_STACK_INFO(); + Tcl_IncrRefCount(valueToAssign); objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, - part2Ptr, objResultPtr, TCL_LEAVE_ERR_MSG, opnd); + part2Ptr, valueToAssign, TCL_LEAVE_ERR_MSG, opnd); + TclDecrRefCount(valueToAssign); CACHE_STACK_INFO(); if (!objResultPtr) { errorInLappendListPtr: - if (createdNewObj) { - TclDecrRefCount(objResultPtr); - } TRACE_ERROR(interp); goto gotError; } diff --git a/tests/execute.test b/tests/execute.test index e1ed68b..e9668a9 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -1066,6 +1066,45 @@ test execute-11.3 {Bug a0ece9d6d4} -setup { trace remove execution crash enterstep {apply {args {info frame -2}}} rename crash {} } -result 1 + +test execute-12.1 {failing multi-lappend to unshared} -setup { + unset -nocomplain x y +} -body { + set x 1 + lappend x 2 3 + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 +} -cleanup { + unset -nocomplain x y +} -returnCodes error -result {can't set "x": boo} +test execute-12.2 {failing multi-lappend to shared} -setup { + unset -nocomplain x y +} -body { + set x 1 + lappend x 2 3 + set y $x + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 +} -cleanup { + unset -nocomplain x y +} -returnCodes error -result {can't set "x": boo} +test execute-12.3 {failing multi-lappend to unshared: LVT} -body { + apply {{} { + set x 1 + lappend x 2 3 + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 + }} +} -returnCodes error -result {can't set "x": boo} +test execute-12.4 {failing multi-lappend to shared: LVT} -body { + apply {{} { + set x 1 + lappend x 2 3 + set y $x + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 + }} +} -returnCodes error -result {can't set "x": boo} # cleanup if {[info commands testobj] != {}} { -- cgit v0.12 From 8ab0ae062eb80ca8ab58df2ad8b08c8fe5503959 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 21 Jun 2019 19:22:07 +0000 Subject: closes [f8a33ce3db5d8cc2]: Tcl_Exit uses system exit as fallback if Tcl-subsystems are not (yet) initialized (or initialization fails). --- generic/tclEvent.c | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index b0b8188..b0bfc15 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -944,16 +944,20 @@ Tcl_Exit( currentAppExitPtr = appExitPtr; Tcl_MutexUnlock(&exitMutex); + /* + * Warning: this function SHOULD NOT return, as there is code that depends + * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone + * returns, so critical is this dependcy. + * + * If subsystems are not (yet) initialized, proper Tcl-finalization is + * impossible, so fallback to system exit, see bug-[f8a33ce3db5d8cc2]. + */ + if (currentAppExitPtr) { - /* - * Warning: this code SHOULD NOT return, as there is code that depends - * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone - * returns, so critical is this dependcy. - */ currentAppExitPtr(INT2PTR(status)); - Tcl_Panic("AppExitProc returned unexpectedly"); - } else { + + } else if (subsystemsInitialized) { if (TclFullFinalizationRequested()) { @@ -986,9 +990,10 @@ Tcl_Exit( FinalizeThread(/* quick */ 1); } - TclpExit(status); - Tcl_Panic("OS exit failed!"); } + + TclpExit(status); + Tcl_Panic("OS exit failed!"); } /* -- cgit v0.12 From 3fe9b57f64ff305397c29748632bcfa5b74a4515 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 24 Jun 2019 07:26:25 +0000 Subject: Fix test title, since TclGetIntForIndex() is now exported as Tcl_GetIntForIndex() --- tests/util.test | 160 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 80 insertions(+), 80 deletions(-) diff --git a/tests/util.test b/tests/util.test index a9199f4..053eb0c 100644 --- a/tests/util.test +++ b/tests/util.test @@ -532,247 +532,247 @@ test util-8.6 {TclNeedSpace - correct UTF8 handling} testdstring { list [llength [testdstring get]] [string length [testdstring get]] } {2 9} -test util-9.0.0 {TclGetIntForIndex} { +test util-9.0.0 {Tcl_GetIntForIndex} { string index abcd 0 } a -test util-9.0.1 {TclGetIntForIndex} { +test util-9.0.1 {Tcl_GetIntForIndex} { string index abcd 0x0 } a -test util-9.0.2 {TclGetIntForIndex} { +test util-9.0.2 {Tcl_GetIntForIndex} { string index abcd -0x0 } a -test util-9.0.3 {TclGetIntForIndex} { +test util-9.0.3 {Tcl_GetIntForIndex} { string index abcd { 0 } } a -test util-9.0.4 {TclGetIntForIndex} { +test util-9.0.4 {Tcl_GetIntForIndex} { string index abcd { 0x0 } } a -test util-9.0.5 {TclGetIntForIndex} { +test util-9.0.5 {Tcl_GetIntForIndex} { string index abcd { -0x0 } } a -test util-9.0.6 {TclGetIntForIndex} { +test util-9.0.6 {Tcl_GetIntForIndex} { string index abcd 01 } b -test util-9.0.7 {TclGetIntForIndex} { +test util-9.0.7 {Tcl_GetIntForIndex} { string index abcd { 01 } } b -test util-9.0.8 {TclGetIntForIndex} { +test util-9.0.8 {Tcl_GetIntForIndex} { string index abcd { 0d0 } } a -test util-9.0.9 {TclGetIntForIndex} { +test util-9.0.9 {Tcl_GetIntForIndex} { string index abcd { -0d0 } } a -test util-9.1.0 {TclGetIntForIndex} { +test util-9.1.0 {Tcl_GetIntForIndex} { string index abcd 3 } d -test util-9.1.1 {TclGetIntForIndex} { +test util-9.1.1 {Tcl_GetIntForIndex} { string index abcd { 3 } } d -test util-9.1.2 {TclGetIntForIndex} { +test util-9.1.2 {Tcl_GetIntForIndex} { string index abcdefghijk 0xa } k -test util-9.1.3 {TclGetIntForIndex} { +test util-9.1.3 {Tcl_GetIntForIndex} { string index abcdefghijk { 0xa } } k -test util-9.1.4 {TclGetIntForIndex} { +test util-9.1.4 {Tcl_GetIntForIndex} { string index abcdefghijk 0d10 } k -test util-9.1.5 {TclGetIntForIndex} { +test util-9.1.5 {Tcl_GetIntForIndex} { string index abcdefghijk { 0d10 } } k -test util-9.2.0 {TclGetIntForIndex} { +test util-9.2.0 {Tcl_GetIntForIndex} { string index abcd end } d -test util-9.2.1 {TclGetIntForIndex} -body { +test util-9.2.1 {Tcl_GetIntForIndex} -body { string index abcd { end} } -returnCodes error -match glob -result * -test util-9.2.2 {TclGetIntForIndex} -body { +test util-9.2.2 {Tcl_GetIntForIndex} -body { string index abcd {end } } -returnCodes error -match glob -result * -test util-9.3 {TclGetIntForIndex} -body { +test util-9.3 {Tcl_GetIntForIndex} -body { # Deprecated string index abcd en } -returnCodes error -match glob -result * -test util-9.4 {TclGetIntForIndex} -body { +test util-9.4 {Tcl_GetIntForIndex} -body { # Deprecated string index abcd e } -returnCodes error -match glob -result * -test util-9.5.0 {TclGetIntForIndex} { +test util-9.5.0 {Tcl_GetIntForIndex} { string index abcd end-1 } c -test util-9.5.1 {TclGetIntForIndex} { +test util-9.5.1 {Tcl_GetIntForIndex} { string index abcd {end-1 } } c -test util-9.5.2 {TclGetIntForIndex} -body { +test util-9.5.2 {Tcl_GetIntForIndex} -body { string index abcd { end-1} } -returnCodes error -match glob -result * -test util-9.6 {TclGetIntForIndex} { +test util-9.6 {Tcl_GetIntForIndex} { string index abcd end+-1 } c -test util-9.7 {TclGetIntForIndex} { +test util-9.7 {Tcl_GetIntForIndex} { string index abcd end+1 } {} -test util-9.8 {TclGetIntForIndex} { +test util-9.8 {Tcl_GetIntForIndex} { string index abcd end--1 } {} -test util-9.9.0 {TclGetIntForIndex} { +test util-9.9.0 {Tcl_GetIntForIndex} { string index abcd 0+0 } a -test util-9.9.1 {TclGetIntForIndex} { +test util-9.9.1 {Tcl_GetIntForIndex} { string index abcd { 0+0 } } a -test util-9.10 {TclGetIntForIndex} { +test util-9.10 {Tcl_GetIntForIndex} { string index abcd 0-0 } a -test util-9.11 {TclGetIntForIndex} { +test util-9.11 {Tcl_GetIntForIndex} { string index abcd 1+0 } b -test util-9.12 {TclGetIntForIndex} { +test util-9.12 {Tcl_GetIntForIndex} { string index abcd 1-0 } b -test util-9.13 {TclGetIntForIndex} { +test util-9.13 {Tcl_GetIntForIndex} { string index abcd 1+1 } c -test util-9.14 {TclGetIntForIndex} { +test util-9.14 {Tcl_GetIntForIndex} { string index abcd 1-1 } a -test util-9.15 {TclGetIntForIndex} { +test util-9.15 {Tcl_GetIntForIndex} { string index abcd -1+2 } b -test util-9.16 {TclGetIntForIndex} { +test util-9.16 {Tcl_GetIntForIndex} { string index abcd -1--2 } b -test util-9.17 {TclGetIntForIndex} { +test util-9.17 {Tcl_GetIntForIndex} { string index abcd { -1+2 } } b -test util-9.18 {TclGetIntForIndex} { +test util-9.18 {Tcl_GetIntForIndex} { string index abcd { -1--2 } } b -test util-9.19 {TclGetIntForIndex} -body { +test util-9.19 {Tcl_GetIntForIndex} -body { string index a {} } -returnCodes error -match glob -result * -test util-9.20 {TclGetIntForIndex} -body { +test util-9.20 {Tcl_GetIntForIndex} -body { string index a { } } -returnCodes error -match glob -result * -test util-9.21 {TclGetIntForIndex} -body { +test util-9.21 {Tcl_GetIntForIndex} -body { string index a " \r\t\n" } -returnCodes error -match glob -result * -test util-9.22 {TclGetIntForIndex} -body { +test util-9.22 {Tcl_GetIntForIndex} -body { string index a + } -returnCodes error -match glob -result * -test util-9.23 {TclGetIntForIndex} -body { +test util-9.23 {Tcl_GetIntForIndex} -body { string index a - } -returnCodes error -match glob -result * -test util-9.24 {TclGetIntForIndex} -body { +test util-9.24 {Tcl_GetIntForIndex} -body { string index a x } -returnCodes error -match glob -result * -test util-9.25 {TclGetIntForIndex} -body { +test util-9.25 {Tcl_GetIntForIndex} -body { string index a +x } -returnCodes error -match glob -result * -test util-9.26 {TclGetIntForIndex} -body { +test util-9.26 {Tcl_GetIntForIndex} -body { string index a -x } -returnCodes error -match glob -result * -test util-9.27 {TclGetIntForIndex} -body { +test util-9.27 {Tcl_GetIntForIndex} -body { string index a 0y } -returnCodes error -match glob -result * -test util-9.28 {TclGetIntForIndex} -body { +test util-9.28 {Tcl_GetIntForIndex} -body { string index a 1* } -returnCodes error -match glob -result * -test util-9.29 {TclGetIntForIndex} -body { +test util-9.29 {Tcl_GetIntForIndex} -body { string index a 0+ } -returnCodes error -match glob -result * -test util-9.30 {TclGetIntForIndex} -body { +test util-9.30 {Tcl_GetIntForIndex} -body { string index a {0+ } } -returnCodes error -match glob -result * -test util-9.31 {TclGetIntForIndex} -body { +test util-9.31 {Tcl_GetIntForIndex} -body { string index a 0x } -returnCodes error -match glob -result * -test util-9.31.1 {TclGetIntForIndex} -body { +test util-9.31.1 {Tcl_GetIntForIndex} -body { string index a 0d } -returnCodes error -match glob -result * -test util-9.32 {TclGetIntForIndex} -body { +test util-9.32 {Tcl_GetIntForIndex} -body { string index a 0x1FFFFFFFF+0 } -result {} -test util-9.33 {TclGetIntForIndex} -body { +test util-9.33 {Tcl_GetIntForIndex} -body { string index a 100000000000+0 } -result {} -test util-9.33.1 {TclGetIntForIndex} -body { +test util-9.33.1 {Tcl_GetIntForIndex} -body { string index a 0d100000000000+0 } -result {} -test util-9.34 {TclGetIntForIndex} -body { +test util-9.34 {Tcl_GetIntForIndex} -body { string index a 1.0 } -returnCodes error -match glob -result * -test util-9.35 {TclGetIntForIndex} -body { +test util-9.35 {Tcl_GetIntForIndex} -body { string index a 1e23 } -returnCodes error -match glob -result * -test util-9.36 {TclGetIntForIndex} -body { +test util-9.36 {Tcl_GetIntForIndex} -body { string index a 1.5e2 } -returnCodes error -match glob -result * -test util-9.37 {TclGetIntForIndex} -body { +test util-9.37 {Tcl_GetIntForIndex} -body { string index a 0+x } -returnCodes error -match glob -result * -test util-9.38 {TclGetIntForIndex} -body { +test util-9.38 {Tcl_GetIntForIndex} -body { string index a 0+0x } -returnCodes error -match glob -result * -test util-9.39 {TclGetIntForIndex} -body { +test util-9.39 {Tcl_GetIntForIndex} -body { string index a 0+0xg } -returnCodes error -match glob -result * -test util-9.40 {TclGetIntForIndex} -body { +test util-9.40 {Tcl_GetIntForIndex} -body { string index a 0+0xg } -returnCodes error -match glob -result * -test util-9.41 {TclGetIntForIndex} -body { +test util-9.41 {Tcl_GetIntForIndex} -body { string index a 0+1.0 } -returnCodes error -match glob -result * -test util-9.42 {TclGetIntForIndex} -body { +test util-9.42 {Tcl_GetIntForIndex} -body { string index a 0+1e2 } -returnCodes error -match glob -result * -test util-9.43 {TclGetIntForIndex} -body { +test util-9.43 {Tcl_GetIntForIndex} -body { string index a 0+1.5e1 } -returnCodes error -match glob -result * -test util-9.44 {TclGetIntForIndex} -body { +test util-9.44 {Tcl_GetIntForIndex} -body { string index a 0+1000000000000 } -result {} -test util-9.45 {TclGetIntForIndex} { +test util-9.45 {Tcl_GetIntForIndex} { string index abcd end+2305843009213693950 } {} -test util-9.46 {TclGetIntForIndex} { +test util-9.46 {Tcl_GetIntForIndex} { string index abcd end+4294967294 } {} # TIP 502 -test util-9.47 {TclGetIntForIndex} { +test util-9.47 {Tcl_GetIntForIndex} { string index abcd 0x10000000000000000 } {} -test util-9.48 {TclGetIntForIndex} { +test util-9.48 {Tcl_GetIntForIndex} { string index abcd -0x10000000000000000 } {} -test util-9.49 {TclGetIntForIndex} -body { +test util-9.49 {Tcl_GetIntForIndex} -body { string index abcd end*1 } -returnCodes error -match glob -result * -test util-9.50 {TclGetIntForIndex} -body { +test util-9.50 {Tcl_GetIntForIndex} -body { string index abcd {end- 1} } -returnCodes error -match glob -result * -test util-9.51 {TclGetIntForIndex} -body { +test util-9.51 {Tcl_GetIntForIndex} -body { string index abcd end-end } -returnCodes error -match glob -result * -test util-9.52 {TclGetIntForIndex} -body { +test util-9.52 {Tcl_GetIntForIndex} -body { string index abcd end-x } -returnCodes error -match glob -result * -test util-9.53 {TclGetIntForIndex} -body { +test util-9.53 {Tcl_GetIntForIndex} -body { string index abcd end-0.1 } -returnCodes error -match glob -result * -test util-9.54 {TclGetIntForIndex} { +test util-9.54 {Tcl_GetIntForIndex} { string index abcd end-0x10000000000000000 } {} -test util-9.55 {TclGetIntForIndex} { +test util-9.55 {Tcl_GetIntForIndex} { string index abcd end+0x10000000000000000 } {} -test util-9.56 {TclGetIntForIndex} { +test util-9.56 {Tcl_GetIntForIndex} { string index abcd end--0x10000000000000000 } {} -test util-9.57 {TclGetIntForIndex} { +test util-9.57 {Tcl_GetIntForIndex} { string index abcd end+-0x10000000000000000 } {} -test util-9.58 {TclGetIntForIndex} { +test util-9.58 {Tcl_GetIntForIndex} { string index abcd end--0x8000000000000000 } {} -- cgit v0.12 From 3c82f32973a705098c58504e8c9d999dc7fe0723 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 24 Jun 2019 20:36:41 +0000 Subject: Better implementation of fpclassify() equivalent. --- generic/tclBasic.c | 81 ++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 73 insertions(+), 8 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a23bfc1..4f64427 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -24,7 +24,11 @@ #include #include #ifndef fpclassify /* Older MSVC */ +#ifdef _M_IX86 +#define REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK +#else /* !_M_IX86 */ #include +#endif /* _M_IX86 */ #endif /* !fpclassify */ #define INTERP_STACK_INITIAL_SIZE 2000 @@ -8329,10 +8333,13 @@ ExprSrandFunc( /* * Older MSVC is supported by Tcl, but doesn't have fpclassify(). Of course. - * But it does have _fpclass() which does almost the same job. + * But it does sometimes have _fpclass() which does almost the same job; if + * even that is absent, we grobble around directly in the platform's binary + * representation of double. * - * This makes it conform to the C99 standard API, and just delegates to the - * standard macro on platforms that do it correctly. + * This function makes all that conform to a common API (effectively the C99 + * standard API renamed), and just delegates to the standard macro on + * platforms that do it correctly. */ static inline int @@ -8342,12 +8349,69 @@ ClassifyDouble( #ifdef fpclassify return fpclassify(d); #else /* !fpclassify */ -#define FP_ZERO 0 -#define FP_NORMAL 1 -#define FP_SUBNORMAL 2 -#define FP_INFINITE 3 -#define FP_NAN 4 +#define FP_NAN 1 +#define FP_INFINITE 2 +#define FP_ZERO 3 +#define FP_NORMAL 4 +#define FP_SUBNORMAL 5 +#ifdef REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK + /* + * We assume this hack is only needed on little-endian systems. + * Specifically, x86 running Windows. It's fairly easy to enable for + * others if they need it (because their libc/libm is broken) but we'll + * jump that hurdle when requred. We can solve the word ordering then. + */ + + union { + double d; + struct { + unsigned int low; + unsigned int high; + } w; + } doubleMeaning; + unsigned int exponent, mantissaLow, mantissaHigh; + int zeroMantissa; +#define EXPONENT_MASK 0x7ff; +#define EXPONENT_SHIFT 20 +#define MANTISSA_MASK 0xfffff + + /* + * Extract the exponent (11 bits) and mantissa (52 bits). Note that we + * totally ignore the sign bit. + */ + + doubleMeaning.d = d; + exponent = (doubleMeaning.w.high >> EXPONENT_SHIFT) & EXPONENT_MASK; + mantissaLow = doubleMeaning.w.low; + mantissaHigh = doubleMeaning.w.high & MANTISSA_MASK; + zeroMantissa = (mantissaHigh == 0 && mantissaLow == 0); + + /* + * Look for the special cases of exponent. + */ + + switch (exponent) { + case 0: + /* + * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. + */ + + return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; + case EXPONENT_MASK: + /* + * When the exponent is all ones, it's an INF or a NAN. + */ + + return zeroMantissa ? FP_INF : FP_NAN; + default: + /* + * Everything else is a NORMAL double precision float. + */ + + return FP_NORMAL; + } +#else /* !REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK */ switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: @@ -8367,6 +8431,7 @@ ClassifyDouble( case _FPCLASS_SNAN: return FP_NAN; } +#endif /* REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK */ #endif /* fpclassify */ } -- cgit v0.12 From 9489b8b506999d9ec543ed3e626cb32ea3a8394a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 25 Jun 2019 06:56:26 +0000 Subject: Squelch C4244 warning on any MSVC compiler. --- win/tclWinPort.h | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 29b1447..20b2fe0 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -480,10 +480,12 @@ typedef DWORD_PTR * PDWORD_PTR; * including the *printf family and others. Tell it to shut up. * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ -#if defined(_MSC_VER) && (_MSC_VER >= 1400) +#if defined(_MSC_VER) # pragma warning(disable:4244) -# pragma warning(disable:4267) -# pragma warning(disable:4996) +# if _MSC_VER >= 1400 +# pragma warning(disable:4267) +# pragma warning(disable:4996) +# endif #endif /* -- cgit v0.12 From f310332a6ba0427e38582673f4d3fbe4b3d9eb5c Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 07:36:28 +0000 Subject: use __builtin_fpclassify for mingw x86 (tested up to gcc 8.1, it seems to have a bug in fpclassify, so [fpclassify 1e-314], x86 => normal, x64 => subnormal) --- generic/tclBasic.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a23bfc1..ea96108 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -8340,7 +8340,13 @@ ClassifyDouble( double d) { #ifdef fpclassify +/* MINGW x86 (tested up to gcc 8.1) seems to have a bug in fpclassify, + * [fpclassify 1e-314], x86 => normal, x64 => subnormal */ +# if defined(__MINGW32__) && defined(_X86_) + return __builtin_fpclassify(FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); +# else return fpclassify(d); +# endif #else /* !fpclassify */ #define FP_ZERO 0 #define FP_NORMAL 1 -- cgit v0.12 From 940b2183da62b66bebfd28cfed0a1dfb80b92a0d Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 25 Jun 2019 08:48:27 +0000 Subject: Where did that stray semicolon come from? Also improve the comments... --- generic/tclBasic.c | 53 +++++++++++++++++++++++++++++++++-------------------- 1 file changed, 33 insertions(+), 20 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 4f64427..de39236 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -8329,17 +8329,15 @@ ExprSrandFunc( * None. * *---------------------------------------------------------------------- - */ - -/* + * * Older MSVC is supported by Tcl, but doesn't have fpclassify(). Of course. * But it does sometimes have _fpclass() which does almost the same job; if * even that is absent, we grobble around directly in the platform's binary * representation of double. * - * This function makes all that conform to a common API (effectively the C99 - * standard API renamed), and just delegates to the standard macro on - * platforms that do it correctly. + * The ClassifyDouble() function makes all that conform to a common API + * (effectively the C99 standard API renamed), and just delegates to the + * standard macro on platforms that do it correctly. */ static inline int @@ -8349,11 +8347,16 @@ ClassifyDouble( #ifdef fpclassify return fpclassify(d); #else /* !fpclassify */ -#define FP_NAN 1 -#define FP_INFINITE 2 -#define FP_ZERO 3 -#define FP_NORMAL 4 -#define FP_SUBNORMAL 5 + /* + * If we don't have fpclassify(), we also don't have the values it returns. + * Hence we define those here. + */ + +#define FP_NAN 1 /* Value is NaN */ +#define FP_INFINITE 2 /* Value is an infinity */ +#define FP_ZERO 3 /* Value is a zero */ +#define FP_NORMAL 4 /* Value is a normal float */ +#define FP_SUBNORMAL 5 /* Value has lost accuracy */ #ifdef REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK /* @@ -8364,17 +8367,27 @@ ClassifyDouble( */ union { - double d; + double d; /* Interpret as double */ struct { - unsigned int low; - unsigned int high; - } w; - } doubleMeaning; + unsigned int low; /* Lower 32 bits */ + unsigned int high; /* Upper 32 bits */ + } w; /* Interpret as unsigned integer words */ + } doubleMeaning; /* So we can look at the representation of a + * double directly. Platform (i.e., processor) + * specific; this is for x86 (and most other + * little-endian processors, but those are + * untested). */ unsigned int exponent, mantissaLow, mantissaHigh; - int zeroMantissa; -#define EXPONENT_MASK 0x7ff; -#define EXPONENT_SHIFT 20 -#define MANTISSA_MASK 0xfffff + /* The pieces extracted from the double. */ + int zeroMantissa; /* Was the mantissa zero? That's special. */ + + /* + * Shifts and masks to use with the doubleMeaning variable above. + */ + +#define EXPONENT_MASK 0x7ff /* 11 bits (after shifting) */ +#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ +#define MANTISSA_MASK 0xfffff /* 20 bits (plus 32 from other word) */ /* * Extract the exponent (11 bits) and mantissa (52 bits). Note that we -- cgit v0.12 From 9fb98b2d11c075c66b5cb297bcd700cf26c81eac Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 10:40:18 +0000 Subject: fixed several fpclassify modes (better recognition and control via TCL_FPCLASSIFY_MODE), typos fixed (FP_INF -> FP_INFINITE), no redefine warnings if FP_* already specified, etc --- generic/tclBasic.c | 50 +++++++++++++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 21 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index de39236..41df33c 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -23,13 +23,20 @@ #include "tommath.h" #include #include -#ifndef fpclassify /* Older MSVC */ -#ifdef _M_IX86 -#define REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK -#else /* !_M_IX86 */ -#include -#endif /* _M_IX86 */ -#endif /* !fpclassify */ + +#ifndef TCL_FPCLASSIFY_MODE +# if ( defined(__MINGW32__) && defined(_X86_) ) /* mingw 32-bit */ +# define TCL_FPCLASSIFY_MODE 1 +# elif defined(fpclassify) /* fpclassify */ +# include +# define TCL_FPCLASSIFY_MODE 0 +# elif defined(_FPCLASS_NN) /* _fpclass */ +# define TCL_FPCLASSIFY_MODE 1 +# else /* !fpclassify && !_fpclass (older MSVC), simulate */ +# define TCL_FPCLASSIFY_MODE 2 +# endif /* !fpclassify */ +#endif /* !TCL_FPCLASSIFY_MODE */ + #define INTERP_STACK_INITIAL_SIZE 2000 #define CORO_STACK_INITIAL_SIZE 200 @@ -8344,21 +8351,22 @@ static inline int ClassifyDouble( double d) { -#ifdef fpclassify +#if TCL_FPCLASSIFY_MODE == 0 return fpclassify(d); #else /* !fpclassify */ /* * If we don't have fpclassify(), we also don't have the values it returns. * Hence we define those here. */ +# ifndef FP_NAN +# define FP_NAN 1 /* Value is NaN */ +# define FP_INFINITE 2 /* Value is an infinity */ +# define FP_ZERO 3 /* Value is a zero */ +# define FP_NORMAL 4 /* Value is a normal float */ +# define FP_SUBNORMAL 5 /* Value has lost accuracy */ +#endif -#define FP_NAN 1 /* Value is NaN */ -#define FP_INFINITE 2 /* Value is an infinity */ -#define FP_ZERO 3 /* Value is a zero */ -#define FP_NORMAL 4 /* Value is a normal float */ -#define FP_SUBNORMAL 5 /* Value has lost accuracy */ - -#ifdef REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK +# if TCL_FPCLASSIFY_MODE == 2 /* * We assume this hack is only needed on little-endian systems. * Specifically, x86 running Windows. It's fairly easy to enable for @@ -8385,9 +8393,9 @@ ClassifyDouble( * Shifts and masks to use with the doubleMeaning variable above. */ -#define EXPONENT_MASK 0x7ff /* 11 bits (after shifting) */ -#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ -#define MANTISSA_MASK 0xfffff /* 20 bits (plus 32 from other word) */ +# define EXPONENT_MASK 0x7ff /* 11 bits (after shifting) */ +# define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ +# define MANTISSA_MASK 0xfffff /* 20 bits (plus 32 from other word) */ /* * Extract the exponent (11 bits) and mantissa (52 bits). Note that we @@ -8416,7 +8424,7 @@ ClassifyDouble( * When the exponent is all ones, it's an INF or a NAN. */ - return zeroMantissa ? FP_INF : FP_NAN; + return zeroMantissa ? FP_INFINITE : FP_NAN; default: /* * Everything else is a NORMAL double precision float. @@ -8424,7 +8432,7 @@ ClassifyDouble( return FP_NORMAL; } -#else /* !REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK */ +# elif TCL_FPCLASSIFY_MODE == 1 switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: @@ -8444,7 +8452,7 @@ ClassifyDouble( case _FPCLASS_SNAN: return FP_NAN; } -#endif /* REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK */ +# endif /* REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK */ #endif /* fpclassify */ } -- cgit v0.12 From da06343b0b1801e88d0f0ebaa60d1559d75e063b Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 11:01:27 +0000 Subject: amend (remove test define) --- generic/tclBasic.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b67648c..2c26202 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -32,9 +32,6 @@ * 3 - __builtin_fpclassify */ -#define TCL_FPCLASSIFY_MODE 3 -#warning mode: TCL_FPCLASSIFY_MODE - #ifndef TCL_FPCLASSIFY_MODE /* * MINGW x86 (tested up to gcc 8.1) seems to have a bug in fpclassify, -- cgit v0.12 From d1b95c26242ba247ebd5656c430b01943b24a728 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 25 Jun 2019 15:50:31 +0000 Subject: Change int constants into char constants. Hopefully this eliminates C4305 warnings on MSVC 6.0 --- generic/tclZipfs.c | 7 +++---- win/tclWinPanic.c | 2 +- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 3d1941c..6a568fe 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -283,10 +283,9 @@ static struct { * For password rotation. */ -static const char pwrot[16] = { - 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0, - 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0 -}; +static const char pwrot[16] = + "\x00\x80\x40\xC0\x20\xA0\x60\xE0" + "\x10\x90\x50\xD0\x30\xB0\x70\xF0"; /* * Table to compute CRC32. diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c index a71f506..5c6e02d 100644 --- a/win/tclWinPanic.c +++ b/win/tclWinPanic.c @@ -58,7 +58,7 @@ Tcl_ConsolePanic( } else if (_isatty(2)) { WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0); } else { - buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */ + buf[0] = '\xEF'; buf[1] = '\xBB'; buf[2] = '\xBF'; /* UTF-8 bom */ WriteFile(handle, buf, strlen(buf), &dummy, 0); WriteFile(handle, "\n", 1, &dummy, 0); FlushFileBuffers(handle); -- cgit v0.12 From be26adf83b00a077251c7242792c50c23fa0baa7 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 16:09:33 +0000 Subject: fixed build with MSVC 6.0 --- generic/tclCmdMZ.c | 14 +++++++------- generic/tclExecute.c | 9 +++------ generic/tclInt.h | 7 +++++++ win/tclWinFile.c | 1 - 4 files changed, 17 insertions(+), 14 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index bc03d73..d36b0f0 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3986,14 +3986,14 @@ Tcl_TimeRateObjCmd( register Tcl_Obj *objPtr; register int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; - Tcl_WideUInt count = 0; /* Holds repetition count */ + TclWideMUInt count = 0; /* Holds repetition count */ Tcl_WideInt maxms = WIDE_MIN; /* Maximal running time (in milliseconds) */ - Tcl_WideUInt maxcnt = WIDE_MAX; + TclWideMUInt maxcnt = WIDE_MAX; /* Maximal count of iterations. */ - Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster + TclWideMUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ - Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max + TclWideMUInt maxIterTm = 1; /* Max time of some iteration as max * threshold, additionally avoiding divide to * zero (i.e., never < 1) */ unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid @@ -4363,13 +4363,13 @@ Tcl_TimeRateObjCmd( { Tcl_Obj *objarr[8], **objs = objarr; - Tcl_WideUInt usec, val; + TclWideMUInt usec, val; int digits; /* * Absolute execution time in microseconds or in wide clicks. */ - usec = (Tcl_WideUInt)(middle - start); + usec = (TclWideMUInt)(middle - start); #ifdef TCL_WIDE_CLICKS /* @@ -4398,7 +4398,7 @@ Tcl_TimeRateObjCmd( * Estimate the time of overhead (microsecs). */ - Tcl_WideUInt curOverhead = overhead * count; + TclWideMUInt curOverhead = overhead * count; if (usec > curOverhead) { usec -= curOverhead; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 265b82f..0c2baab 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4938,7 +4938,7 @@ TclExecuteByteCode( } #endif { - mp_int big2; + mp_int big1, big2; Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); @@ -4956,8 +4956,6 @@ TclExecuteByteCode( * Arguments are opposite sign; remainder is sum. */ - mp_int big1; - TclBNInitBignumFromLong(&big1, l1); mp_add(&big2, &big1, &big2); mp_clear(&big1); @@ -4994,7 +4992,8 @@ TclExecuteByteCode( NEXT_INST_F(1, 2, 1); } { - mp_int big2; + mp_int big1, big2; + Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); /* TODO: internals intrusion */ @@ -5011,8 +5010,6 @@ TclExecuteByteCode( * Arguments are opposite sign; remainder is sum. */ - mp_int big1; - TclBNInitBignumFromWideInt(&big1, w1); mp_add(&big2, &big1, &big2); mp_clear(&big1); diff --git a/generic/tclInt.h b/generic/tclInt.h index 8b4ccc5..974dd0d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2773,6 +2773,13 @@ MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclpFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); +/* TclWideMUInt -- wide integer used for measurement calculations: */ +#if (!defined(_WIN32) || !defined(_MSC_VER) || (_MSC_VER >= 1400)) +# define TclWideMUInt Tcl_WideUInt +#else +/* older MSVS may not allow conversions between unsigned __int64 and double) */ +# define TclWideMUInt Tcl_WideInt +#endif #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 8ee4bce..d582664 100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -17,7 +17,6 @@ #include #include #include /* For TclpGetUserHome(). */ -#include /* For TclpGetUserHome(). */ /* * The number of 100-ns intervals between the Windows system epoch (1601-01-01 -- cgit v0.12 From 334b8029eddb4e6df592c5f540ade0fd957a72c1 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 17:45:23 +0000 Subject: nmakehlp: fixed const qualifier --- win/nmakehlp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 0439d1c..6532f8a 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -74,7 +74,7 @@ main( char msg[300]; DWORD dwWritten; int chars; - char *s; + const char *s; /* * Make sure children (cl.exe and link.exe) are kept quiet. -- cgit v0.12 From 9392d9001aff32b293b587f531e08a54f534b2c2 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 18:59:09 +0000 Subject: restore userenv, used in 8.6 --- win/tclWinFile.c | 1 + 1 file changed, 1 insertion(+) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 49f85cb..2f35d4a 100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -17,6 +17,7 @@ #include #include #include /* For TclpGetUserHome(). */ +#include /* For TclpGetUserHome(). */ #include /* For GetNamedSecurityInfo */ #ifdef _MSC_VER -- cgit v0.12 From 5ef1c629dfce15837e4cb375f572a85c36a27773 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 25 Jun 2019 22:27:43 +0000 Subject: Makef tclTomMath.h work with VC++ 6.0 --- generic/tclTomMath.h | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h index bbcb4bc..9da642e 100644 --- a/generic/tclTomMath.h +++ b/generic/tclTomMath.h @@ -84,7 +84,11 @@ typedef unsigned int mp_digit; #define MP_DIGIT_DECLARED #endif #ifndef MP_WORD_DECLARED +#ifdef _WIN32 +typedef unsigned __int64 mp_word; +#else typedef unsigned long long mp_word; +#endif #define MP_WORD_DECLARED #endif -- cgit v0.12 From 595cb8637968efc657003e13c57b37354f1f66d6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 26 Jun 2019 08:21:19 +0000 Subject: Remove EXECUTE flag for tclWinFile.c. More eol-spacing cleanup (keeping tests-pref/* among other the same in multiple branches) --- README.md | 2 +- library/http1.0/http.tcl | 6 +++--- library/opt/optparse.tcl | 18 +++++++++--------- macosx/configure.ac | 2 +- tests-perf/clock.perf.tcl | 14 +++++++------- tests-perf/test-performance.tcl | 10 +++++----- tests-perf/timer-event.perf.tcl | 16 ++++++++-------- win/nmakehlp.c | 1 - win/tclWinFile.c | 0 9 files changed, 34 insertions(+), 35 deletions(-) mode change 100755 => 100644 win/tclWinFile.c diff --git a/README.md b/README.md index 3c4440e..efad379 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ # README: Tcl This is the **Tcl 8.5.19** source distribution. - + You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). diff --git a/library/http1.0/http.tcl b/library/http1.0/http.tcl index 8041ee4..8329de4 100644 --- a/library/http1.0/http.tcl +++ b/library/http1.0/http.tcl @@ -339,12 +339,12 @@ proc http_formatQuery {args} { # 2 Convert every other character to an array lookup # 3 Escape constructs that are "special" to the tcl parser # 4 "subst" the result, doing all the array substitutions - + proc httpMapReply {string} { global httpFormMap set alphanumeric a-zA-Z0-9 if {![info exists httpFormMap]} { - + for {set i 1} {$i <= 256} {incr i} { set c [format %c $i] if {![string match \[$alphanumeric\] $c]} { @@ -363,7 +363,7 @@ proc http_formatQuery {args} { return [subst $string] } -# Default proxy filter. +# Default proxy filter. proc httpProxyRequired {host} { global http if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} { diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl index c9438a0..8caaac4 100644 --- a/library/opt/optparse.tcl +++ b/library/opt/optparse.tcl @@ -33,7 +33,7 @@ namespace eval ::tcl { # Every OptProc give usage information on "procname -help". # Try "tcl::OptParseTest -help" and "tcl::OptParseTest -a" and # then other arguments. - # + # # example of 'valid' call: # ::tcl::OptParseTest save -4 -pr 23 -libsok SybTcl\ # -nostatics false ch1 @@ -84,8 +84,8 @@ namespace eval ::tcl { # # The general structure of a "program" is # notation (pseudo bnf like) -# name :== definition defines "name" as being "definition" -# { x y z } means list of x, y, and z +# name :== definition defines "name" as being "definition" +# { x y z } means list of x, y, and z # x* means x repeated 0 or more time # x+ means "x x*" # x? means optionally x @@ -110,7 +110,7 @@ namespace eval ::tcl { # # And for this application: # -# singleStep :== { instruction varname {hasBeenSet currentValue} type +# singleStep :== { instruction varname {hasBeenSet currentValue} type # typeArgs help } # instruction :== "flags" | "value" # type :== knowType | anyword @@ -343,7 +343,7 @@ proc ::tcl::OptProcArgGiven {argname} { proc OptState {item} { lindex $item 0 } - + # current state proc OptCurState {descriptions} { OptState [OptCurDesc $descriptions]; @@ -535,7 +535,7 @@ proc ::tcl::OptKeyParse {descKey arglist} { if {![Lempty $arglist]} { return -code error [OptTooManyArgs $desc $arglist]; } - + # Analyse the result # Walk through the tree: OptTreeVars $desc "#[expr {[info level]-1}]" ; @@ -781,7 +781,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} { 3 { # varname type value # varname value comment - + if {[regexp {^-(.+)$} $arg1 x type]} { # flags/optValue as they are optional, need a "value", # on the contrary, for a variable (non optional), @@ -919,7 +919,7 @@ proc ::tcl::OptError {prefix desc {header 0}} { set desc [concat $h $desc] } OptLengths $desc nl tl dl - # actually output + # actually output return "$prefix[OptTree $desc $nl $tl $dl]" } @@ -952,7 +952,7 @@ proc ::tcl::Lget {list indexLst} { # it would be even slower... needs to be written in C !) # (nb: there is a non trivial recursive problem with indexes 0, # which appear because there is no difference between a list -# of 1 element and 1 element alone : [list "a"] == "a" while +# of 1 element and 1 element alone : [list "a"] == "a" while # it should be {a} and [listp a] should be 0 while [listp {a b}] would be 1 # and [listp "a b"] maybe 0. listp does not exist either...) proc ::tcl::Lvarset {listName indexLst newValue} { diff --git a/macosx/configure.ac b/macosx/configure.ac index 01c3697..f7a8bb3 100644 --- a/macosx/configure.ac +++ b/macosx/configure.ac @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. -dnl Ensure that the config (auto)headers support is used, then just +dnl Ensure that the config (auto)headers support is used, then just dnl include the configure sources from ../unix: m4_include(../unix/aclocal.m4) diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index d574c2c..f80746f 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -2,18 +2,18 @@ # ------------------------------------------------------------------------ # # test-performance.tcl -- -# +# # This file provides common performance tests for comparison of tcl-speed # degradation by switching between branches. # (currently for clock ensemble only) # # ------------------------------------------------------------------------ -# +# # Copyright (c) 2014 Serg G. Brester (aka sebres) -# +# # See the file "license.terms" for information on usage and redistribution # of this file. -# +# array set in {-time 500} if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { @@ -215,7 +215,7 @@ proc test-freescan {{reptime 1000}} { {clock scan "next January" -base 0 -gmt 1} # FreeScan : relative week {clock scan "next Fri" -base 0 -gmt 1} - # FreeScan : relative weekday and week offset + # FreeScan : relative weekday and week offset {clock scan "next January + 2 week" -base 0 -gmt 1} # FreeScan : time only with base {clock scan "19:18:30" -base 148863600 -gmt 1} @@ -300,7 +300,7 @@ proc test-convert {{reptime 1000}} { {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone EST} # Format locale 1x: comparison values - {clock format 0 -gmt 1 -locale en} + {clock format 0 -gmt 1 -locale en} {clock format 0 -gmt 1 -locale de} {clock format 0 -gmt 1 -locale fr} # Format locale 2x: without switching locale (en, en) @@ -340,7 +340,7 @@ proc test-convert {{reptime 1000}} { {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 EST" -base 148863600} # FreeScan TZ 2x (+1 gmt, +1 system-default) {clock scan "19:18:30 MST" -base 148863600 -gmt 1; clock scan "19:18:30 EST" -base 148863600} - + # Scan TZ: comparison included in scan string vs. given {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"} {clock scan "2009-06-30T18:30:00 CET" -format "%Y-%m-%dT%H:%M:%S %z"} diff --git a/tests-perf/test-performance.tcl b/tests-perf/test-performance.tcl index a05c380..78189e6 100644 --- a/tests-perf/test-performance.tcl +++ b/tests-perf/test-performance.tcl @@ -1,19 +1,19 @@ # ------------------------------------------------------------------------ # # test-performance.tcl -- -# +# # This file provides common performance tests for comparison of tcl-speed # degradation or regression by switching between branches. # # To execute test case evaluate direct corresponding file "tests-perf\*.perf.tcl". # # ------------------------------------------------------------------------ -# +# # Copyright (c) 2014 Serg G. Brester (aka sebres) -# +# # See the file "license.terms" for information on usage and redistribution # of this file. -# +# namespace eval ::tclTestPerf { # warm-up interpeter compiler env, calibrate timerate measurement functionality: @@ -33,7 +33,7 @@ if {[lindex [timerate {} 10] 6] >= (10-1)} { } proc {**STOP**} {args} { - return -code error -level 4 "**STOP** in [info level [expr {[info level]-2}]] [join $args { }]" + return -code error -level 4 "**STOP** in [info level [expr {[info level]-2}]] [join $args { }]" } proc _test_get_commands {lst} { diff --git a/tests-perf/timer-event.perf.tcl b/tests-perf/timer-event.perf.tcl index c5a7d45..f68a56a 100644 --- a/tests-perf/timer-event.perf.tcl +++ b/tests-perf/timer-event.perf.tcl @@ -3,17 +3,17 @@ # ------------------------------------------------------------------------ # # timer-event.perf.tcl -- -# +# # This file provides performance tests for comparison of tcl-speed # of timer events (event-driven tcl-handling). # # ------------------------------------------------------------------------ -# +# # Copyright (c) 2014 Serg G. Brester (aka sebres) -# +# # See the file "license.terms" for information on usage and redistribution # of this file. -# +# if {![namespace exists ::tclTestPerf]} { @@ -40,7 +40,7 @@ proc test-queue {{reptime {1000 10000}}} { {after idle {set foo bar}} # update / after idle: {update; if {![llength [after info]]} break} - + # generate up to $howmuch idle-events: {after idle {set foo bar}} # update idletasks / after idle: @@ -50,7 +50,7 @@ proc test-queue {{reptime {1000 10000}}} { {after 0 {set foo bar}} # update / after 0: {update; if {![llength [after info]]} break} - + # generate up to $howmuch 1-ms events: {after 1 {set foo bar}} setup {after 1} @@ -83,7 +83,7 @@ proc test-queue {{reptime {1000 10000}}} { setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events} {after cancel $ev([incr i -1]); if {$i <= 1} break} cleanup {update; unset -nocomplain ev} - + # end $howmuch events. cleanup {if [llength [after info]] {error "unexpected: [llength [after info]] events are still there."}} }] @@ -149,7 +149,7 @@ proc test-long {{reptime 1000}} { {time {after idle {after 30}} 10; after 1 {set important 1}; vwait important;} cleanup {foreach i [after info] {after cancel $i}} # in-between important event (of new generation) by amount of idle events: - {time {after idle {after 30}} 10; after 1 {after 0 {set important 1}}; vwait important;} + {time {after idle {after 30}} 10; after 1 {after 0 {set important 1}}; vwait important;} cleanup {foreach i [after info] {after cancel $i}} } } diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 6532f8a..821d00b 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -39,7 +39,6 @@ #endif - /* protos */ static int CheckForCompilerFeature(const char *option); diff --git a/win/tclWinFile.c b/win/tclWinFile.c old mode 100755 new mode 100644 -- cgit v0.12 From c4459402a9117b184d3ad0d2640628db19327ae4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 26 Jun 2019 08:27:51 +0000 Subject: UNEXEC win/tclWinFile.c --- win/tclWinFile.c | 0 1 file changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 win/tclWinFile.c diff --git a/win/tclWinFile.c b/win/tclWinFile.c old mode 100755 new mode 100644 -- cgit v0.12