diff options
| -rw-r--r-- | doc/LinkVar.3 | 48 | ||||
| -rw-r--r-- | generic/tclExecute.c | 22 | ||||
| -rw-r--r-- | generic/tclLink.c | 31 | ||||
| -rw-r--r-- | generic/tclObj.c | 8 | ||||
| -rw-r--r-- | library/init.tcl | 5 | ||||
| -rw-r--r-- | tests/expr.test | 9 |
6 files changed, 73 insertions, 50 deletions
diff --git a/doc/LinkVar.3 b/doc/LinkVar.3 index a77fe21..c80d30d 100644 --- a/doc/LinkVar.3 +++ b/doc/LinkVar.3 @@ -61,7 +61,9 @@ The C variable is of type \fBint\fR. Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetIntFromObj\fR; attempts to write non-integer values into \fIvarName\fR will be rejected with -Tcl errors. +Tcl errors. Incomplete integer representations (like the empty +string, '+', '-' or the hex/octal/binary prefix) are accepted +as if they are valid too. .TP \fBTCL_LINK_UINT\fR The C variable is of type \fBunsigned int\fR. @@ -69,14 +71,18 @@ Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the platform's defined range for the \fBunsigned int\fR type; attempts to write non-integer values (or values outside the range) into -\fIvarName\fR will be rejected with Tcl errors. +\fIvarName\fR will be rejected with Tcl errors. Incomplete integer +representations (like the empty string, '+', '-' or the hex/octal/binary +prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_CHAR\fR The C variable is of type \fBchar\fR. Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the \fBchar\fR datatype; attempts to write non-integer or out-of-range -values into \fIvarName\fR will be rejected with Tcl errors. +values into \fIvarName\fR will be rejected with Tcl errors. Incomplete +integer representations (like the empty string, '+', '-' or the +hex/octal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_UCHAR\fR The C variable is of type \fBunsigned char\fR. @@ -84,14 +90,18 @@ Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetIntFromObj\fR and in the platform's defined range for the \fBunsigned char\fR type; attempts to write non-integer values (or values outside the range) into -\fIvarName\fR will be rejected with Tcl errors. +\fIvarName\fR will be rejected with Tcl errors. Incomplete integer +representations (like the empty string, '+', '-' or the hex/octal/binary +prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_SHORT\fR The C variable is of type \fBshort\fR. Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the \fBshort\fR datatype; attempts to write non-integer or out-of-range -values into \fIvarName\fR will be rejected with Tcl errors. +values into \fIvarName\fR will be rejected with Tcl errors. Incomplete +integer representations (like the empty string, '+', '-' or the +hex/octal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_USHORT\fR The C variable is of type \fBunsigned short\fR. @@ -99,14 +109,18 @@ Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetIntFromObj\fR and in the platform's defined range for the \fBunsigned short\fR type; attempts to write non-integer values (or values outside the range) into -\fIvarName\fR will be rejected with Tcl errors. +\fIvarName\fR will be rejected with Tcl errors. Incomplete integer +representations (like the empty string, '+', '-' or the hex/octal/binary +prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_LONG\fR The C variable is of type \fBlong\fR. Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetLongFromObj\fR; attempts to write non-integer or out-of-range -values into \fIvarName\fR will be rejected with Tcl errors. +values into \fIvarName\fR will be rejected with Tcl errors. Incomplete +integer representations (like the empty string, '+', '-' or the +hex/octal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_ULONG\fR The C variable is of type \fBunsigned long\fR. @@ -114,14 +128,18 @@ Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the platform's defined range for the \fBunsigned long\fR type; attempts to write non-integer values (or values outside the range) into -\fIvarName\fR will be rejected with Tcl errors. +\fIvarName\fR will be rejected with Tcl errors. Incomplete integer +representations (like the empty string, '+', '-' or the hex/octal/binary +prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_DOUBLE\fR The C variable is of type \fBdouble\fR. Any value written into the Tcl variable must have a proper real form acceptable to \fBTcl_GetDoubleFromObj\fR; attempts to write non-real values into \fIvarName\fR will be rejected with -Tcl errors. +Tcl errors. Incomplete integer or real representations (like the +empty string, '.', '+', '-' or the hex/octal/binary prefix) are +accepted as if they are valid too. .TP \fBTCL_LINK_FLOAT\fR The C variable is of type \fBfloat\fR. @@ -129,7 +147,9 @@ Any value written into the Tcl variable must have a proper real form acceptable to \fBTcl_GetDoubleFromObj\fR and must be within the range acceptable for a \fBfloat\fR; attempts to write non-real values (or values outside the range) into -\fIvarName\fR will be rejected with Tcl errors. +\fIvarName\fR will be rejected with Tcl errors. Incomplete integer +or real representations (like the empty string, '.', '+', '-' or +the hex/octal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_WIDE_INT\fR The C variable is of type \fBTcl_WideInt\fR (which is an integer type @@ -137,7 +157,9 @@ at least 64-bits wide on all platforms that can support it.) Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetWideIntFromObj\fR; attempts to write non-integer values into \fIvarName\fR will be rejected with -Tcl errors. +Tcl errors. Incomplete integer representations (like the empty +string, '+', '-' or the hex/octal/binary prefix) are accepted +as if they are valid too. .TP \fBTCL_LINK_WIDE_UINT\fR The C variable is of type \fBTcl_WideUInt\fR (which is an unsigned @@ -148,7 +170,9 @@ integer form acceptable to \fBTcl_GetWideIntFromObj\fR (it will be cast to unsigned); .\" FIXME! Use bignums instead. attempts to write non-integer values into \fIvarName\fR will be -rejected with Tcl errors. +rejected with Tcl errors. Incomplete integer representations (like +the empty string, '+', '-' or the hex/octal/binary prefix) are accepted +as if they are valid too. .TP \fBTCL_LINK_BOOLEAN\fR The C variable is of type \fBint\fR. diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 24848bd..bebc730 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5958,16 +5958,17 @@ TEBCresume( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) { + if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK + || GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) { /* * At least one non-numeric argument - compare as strings. */ goto stringCompare; } - if (type1 == TCL_NUMBER_NAN) { + if (type1 == TCL_NUMBER_NAN || type2 == TCL_NUMBER_NAN) { /* - * NaN first arg: NaN != to everything, other compares are false. + * NaN arg: NaN != to everything, other compares are false. */ iResult = (*pc == INST_NEQ); @@ -5977,21 +5978,6 @@ TEBCresume( compare = MP_EQ; goto convertComparison; } - if (GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) { - /* - * At least one non-numeric argument - compare as strings. - */ - - goto stringCompare; - } - if (type2 == TCL_NUMBER_NAN) { - /* - * NaN 2nd arg: NaN != to everything, other compares are false. - */ - - iResult = (*pc == INST_NEQ); - goto foundResult; - } if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { l1 = *((const long *)ptr1); l2 = *((const long *)ptr2); diff --git a/generic/tclLink.c b/generic/tclLink.c index 353b643..6f155a8 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -711,7 +711,7 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) { /* * This function checks for integer representations, which are valid * when linking with C variables, but which are invalid in other - * contexts in Tcl. Handled are "", "+", "-", "0x", "0b" and "0o" + * contexts in Tcl. Handled are "+", "-", "", "0x", "0b" and "0o" * (upperand lowercase). See bug [39f6304c2e]. */ int @@ -719,13 +719,13 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr) { const char *str = TclGetString(objPtr); - if ((objPtr->length == 1) && strchr("+-", str[0])) { - *intPtr = (str[0] == '+'); - return TCL_OK; - } else if ((objPtr->length == 0) || + if ((objPtr->length == 0) || ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) { *intPtr = 0; return TCL_OK; + } else if ((objPtr->length == 1) && strchr("+-", str[0])) { + *intPtr = (str[0] == '+'); + return TCL_OK; } return TCL_ERROR; } @@ -733,25 +733,28 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr) /* * This function checks for double representations, which are valid * when linking with C variables, but which are invalid in other - * contexts in Tcl. Handled are ".", "+", "-", "0x", "0b" and "0o" + * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o" * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e]. */ int GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr) { - int intValue, result; + int intValue; - if ((objPtr->typePtr == &invalidRealType) || - (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK)) { - *doublePtr = objPtr->internalRep.doubleValue; - return TCL_OK; + if (objPtr->typePtr == &invalidRealType) { + goto gotdouble; } - result = GetInvalidIntFromObj(objPtr, &intValue); - if (result == TCL_OK) { + if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) { *doublePtr = (double) intValue; + return TCL_OK; } - return result; + if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) { + gotdouble: + *doublePtr = objPtr->internalRep.doubleValue; + return TCL_OK; + } + return TCL_ERROR; } /* diff --git a/generic/tclObj.c b/generic/tclObj.c index 5968ff9..9b43120 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2983,7 +2983,7 @@ Tcl_GetLongFromObj( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", - Tcl_GetString(objPtr))); + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; @@ -3282,7 +3282,7 @@ Tcl_GetWideIntFromObj( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", - Tcl_GetString(objPtr))); + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; @@ -3616,7 +3616,7 @@ GetBignumFromObj( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", - Tcl_GetString(objPtr))); + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; @@ -4166,7 +4166,7 @@ TclCompareObjKeys( Tcl_Obj *objPtr1 = keyPtr; Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; register const char *p1, *p2; - register int l1, l2; + register size_t l1, l2; /* * If the object pointers are the same then they match. diff --git a/library/init.tcl b/library/init.tcl index 544ea77..5a9e87c 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -636,8 +636,9 @@ proc auto_execok name { } set auto_execs($name) "" - set shellBuiltins [list cls copy date del dir echo erase md mkdir \ - mklink rd ren rename rmdir start time type ver vol] + set shellBuiltins [list assoc cls copy date del dir echo erase ftype \ + md mkdir mklink move rd ren rename rmdir start \ + time type ver vol] if {[info exists env(PATHEXT)]} { # Add an initial ; to have the {} extension check first. set execExtensions [split ";$env(PATHEXT)" ";"] diff --git a/tests/expr.test b/tests/expr.test index 4046411..8e083c5 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -910,6 +910,15 @@ test expr-22.9 {non-numeric floats: shared object equality and NaN} { set x NaN expr {$x == $x} } 0 +# Make sure [Bug d0f7ba56f0] stays fixed. +test expr-22.10 {non-numeric arguments: equality and NaN} { + set x NaN + expr {$x > "Gran"} +} 1 +test expr-22.11 {non-numeric arguments: equality and NaN} { + set x NaN + expr {"Gran" < $x} +} 1 # Tests for exponentiation handling test expr-23.1 {CompileExponentialExpr: just exponential expr} {expr 4**2} 16 |