aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--jim.c186
-rw-r--r--jim_tcl.txt40
-rw-r--r--tests/expr-base.test39
-rw-r--r--tests/expr-new.test8
-rw-r--r--tests/expr-old.test2
-rw-r--r--tests/jim.test10
-rw-r--r--tests/lsort.test4
-rw-r--r--tests/scan.test4
-rw-r--r--tests/string.test2
9 files changed, 233 insertions, 62 deletions
diff --git a/jim.c b/jim.c
index 3904ba9..7964b8d 100644
--- a/jim.c
+++ b/jim.c
@@ -440,11 +440,107 @@ static int JimCheckConversion(const char *str, const char *endptr)
return JIM_OK;
}
+/* Parses the front of a number to determine it's sign and base
+ * Returns the index to start parsing according to the given base
+ */
+static int JimNumberBase(const char *str, int *base, int *sign)
+{
+ int i = 0;
+
+ *base = 10;
+
+ while (isspace(UCHAR(str[i]))) {
+ i++;
+ }
+
+ if (str[i] == '-') {
+ *sign = -1;
+ i++;
+ }
+ else {
+ if (str[i] == '+') {
+ i++;
+ }
+ *sign = 1;
+ }
+
+ if (str[i] != '0') {
+ /* base 10 */
+ return 0;
+ }
+
+ /* We have 0<x>, so see if we can convert it */
+ switch (str[i + 1]) {
+ case 'x': case 'X': *base = 16; break;
+ case 'o': case 'O': *base = 8; break;
+ case 'b': case 'B': *base = 2; break;
+ default: return 0;
+ }
+ i += 2;
+ /* Ensure that (e.g.) 0x-5 fails to parse */
+ if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
+ /* Parse according to this base */
+ return i;
+ }
+ /* Parse as base 10 */
+ return 10;
+}
+
+/* Converts a number as per strtol(..., 0) except leading zeros do *not*
+ * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
+ */
+static long jim_strtol(const char *str, char **endptr)
+{
+ int sign;
+ int base;
+ int i = JimNumberBase(str, &base, &sign);
+
+ if (base != 10) {
+ long value = strtol(str + i, endptr, base);
+ if (endptr == NULL || *endptr != str + i) {
+ return value * sign;
+ }
+ }
+
+ /* Can just do a regular base-10 conversion */
+ return strtol(str, endptr, 10);
+}
+
+
+/* Converts a number as per strtoull(..., 0) except leading zeros do *not*
+ * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
+ */
+static unsigned long long jim_strtoull(const char *str, char **endptr)
+{
+#ifdef HAVE_LONG_LONG
+ int sign;
+ int base;
+ int i = JimNumberBase(str, &base, &sign);
+
+ if (base != 10) {
+ long value = strtoull(str + i, endptr, base);
+ if (endptr == NULL || *endptr != str + i) {
+ return value * sign;
+ }
+ }
+
+ /* Can just do a regular base-10 conversion */
+ return strtoull(str, endptr, 10);
+#else
+ return (unsigned long)jim_strtol(str, endptr);
+#endif
+}
+
int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
{
char *endptr;
- *widePtr = strtoull(str, &endptr, base);
+ if (base) {
+ *widePtr = strtoull(str, &endptr, base);
+ }
+ else {
+ *widePtr = jim_strtoull(str, &endptr);
+ }
return JimCheckConversion(str, endptr);
}
@@ -5390,7 +5486,7 @@ Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
if (str[0] == '#') {
char *endptr;
- level = strtol(str + 1, &endptr, 0);
+ level = jim_strtol(str + 1, &endptr);
if (str[1] == '\0' || endptr[0] != '\0') {
level = -1;
}
@@ -7031,7 +7127,7 @@ int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
idx = 0;
}
else {
- idx = strtol(str, &endptr, 0);
+ idx = jim_strtol(str, &endptr);
if (endptr == str) {
goto badindex;
@@ -7043,7 +7139,7 @@ int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
if (*str == '+' || *str == '-') {
int sign = (*str == '+' ? 1 : -1);
- idx += sign * strtol(++str, &endptr, 0);
+ idx += sign * jim_strtol(++str, &endptr);
if (str == endptr || *endptr) {
goto badindex;
}
@@ -8147,28 +8243,53 @@ singlechar:
static int JimParseExprNumber(struct JimParserCtx *pc)
{
int allowdot = 1;
- int allowhex = 0;
+ int base = 10;
/* Assume an integer for now */
pc->tt = JIM_TT_EXPR_INT;
pc->tstart = pc->p;
pc->tline = pc->linenr;
+
+ /* Parse initial 0<x> */
+ if (pc->p[0] == '0') {
+ switch (pc->p[1]) {
+ case 'x':
+ case 'X':
+ base = 16;
+ allowdot = 0;
+ pc->p += 2;
+ pc->len -= 2;
+ break;
+ case 'o':
+ case 'O':
+ base = 8;
+ allowdot = 0;
+ pc->p += 2;
+ pc->len -= 2;
+ break;
+ case 'b':
+ case 'B':
+ base = 2;
+ allowdot = 0;
+ pc->p += 2;
+ pc->len -= 2;
+ break;
+ }
+ }
+
while (isdigit(UCHAR(*pc->p))
- || (allowhex && isxdigit(UCHAR(*pc->p)))
+ || (base == 16 && isxdigit(UCHAR(*pc->p)))
+ || (base == 8 && *pc->p >= '0' && *pc->p <= '7')
+ || (base == 2 && (*pc->p == '0' || *pc->p == '1'))
|| (allowdot && *pc->p == '.')
- || (pc->p - pc->tstart == 1 && *pc->tstart == '0' && (*pc->p == 'x' || *pc->p == 'X'))
) {
- if ((*pc->p == 'x') || (*pc->p == 'X')) {
- allowhex = 1;
- allowdot = 0;
- }
if (*pc->p == '.') {
allowdot = 0;
pc->tt = JIM_TT_EXPR_DOUBLE;
}
pc->p++;
pc->len--;
- if (!allowhex && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
+ if (base == 10 && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
|| isdigit(UCHAR(pc->p[1])))) {
pc->p += 2;
pc->len -= 2;
@@ -8677,8 +8798,9 @@ static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList
case JIM_TT_DICTSUGAR:
case JIM_TT_EXPRSUGAR:
case JIM_TT_CMD:
- token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
token->type = t->type;
+strexpr:
+ token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
if (t->type == JIM_TT_CMD) {
/* Only commands need source info */
JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
@@ -8687,15 +8809,24 @@ static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList
break;
case JIM_TT_EXPR_INT:
- token->objPtr = Jim_NewIntObj(interp, strtoull(t->token, NULL, 0));
- token->type = t->type;
- expr->len++;
- break;
-
case JIM_TT_EXPR_DOUBLE:
- token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, NULL));
- token->type = t->type;
- expr->len++;
+ {
+ char *endptr;
+ if (t->type == JIM_TT_EXPR_INT) {
+ token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
+ }
+ else {
+ token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
+ }
+ if (endptr != t->token + t->len) {
+ /* Conversion failed, so just store it as a string */
+ Jim_FreeNewObj(interp, token->objPtr);
+ token->type = JIM_TT_STR;
+ goto strexpr;
+ }
+ token->type = t->type;
+ expr->len++;
+ }
break;
case JIM_TT_SUBEXPR_START:
@@ -9561,14 +9692,11 @@ static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen
: descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
/* Try to scan a number with the given base */
- w = strtoull(tok, &endp, base);
- if (endp == tok && base == 0) {
- /* If scanning failed, and base was undetermined, simply
- * put it to 10 and try once more. This should catch the
- * case where %i begin to parse a number prefix (e.g.
- * '0x' but no further digits follows. This will be
- * handled as a ZERO followed by a char 'x' by Tcl) */
- w = strtoull(tok, &endp, 10);
+ if (base == 0) {
+ w = jim_strtoull(tok, &endp);
+ }
+ else {
+ w = strtoull(tok, &endp, base);
}
if (endp != tok) {
diff --git a/jim_tcl.txt b/jim_tcl.txt
index b30be8f..805b7a6 100644
--- a/jim_tcl.txt
+++ b/jim_tcl.txt
@@ -3,7 +3,7 @@ Jim Tcl(n)
NAME
----
-Jim Tcl v0.73 - reference manual for the Jim Tcl scripting language
+Jim Tcl v0.74 - reference manual for the Jim Tcl scripting language
SYNOPSIS
--------
@@ -52,6 +52,10 @@ Some notable differences with Tcl 8.5/8.6 are:
RECENT CHANGES
--------------
+Changes between 0.73 and 0.74
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+1. Numbers with leading zeros are treated as decimal, not octal
+
Changes between 0.72 and 0.73
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1. Built-in regexp now support non-capturing parentheses: (?:...)
@@ -96,20 +100,6 @@ Changes between 0.70 and 0.71
11. Add `string byterange`
12. Built-in regexp now support non-greedy repetition (*?, +?, ??)
-Changes between 0.63 and 0.70
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-1. +platform_tcl()+ settings are now automatically determined
-2. Add aio `$handle filename`
-3. Add `info channels`
-4. The 'bio' extension is gone. Now `aio` supports 'copyto'.
-5. Add `exists` command
-6. Add the pure-Tcl 'oo' extension
-7. The `exec` command now only uses vfork(), not fork()
-8. Unit test framework is less verbose and more Tcl-compatible
-9. Optional UTF-8 support
-10. Optional built-in regexp engine for better Tcl compatibility and UTF-8 support
-11. Command line editing in interactive mode, e.g. 'jimsh'
-
TCL INTRODUCTION
-----------------
Tcl stands for 'tool command language' and is pronounced 'tickle.'
@@ -671,9 +661,9 @@ White space may be used between the operands and operators and
parentheses; it is ignored by the expression processor.
Where possible, operands are interpreted as integer values.
-Integer values may be specified in decimal (the normal case), in octal (if the
-first character of the operand is '0'), or in hexadecimal (if the first
-two characters of the operand are '0x').
+Integer values may be specified in decimal (the normal case) or in
+hexadecimal (if the first two characters of the operand are '0x').
+Note that Jim Tcl does *not* treat numbers with leading zeros as octal.
If an operand does not have one of the integer formats given
above, then it is treated as a floating-point number if that is
@@ -4926,6 +4916,20 @@ The following global variables are set by jimsh.
CHANGES IN PREVIOUS RELEASES
----------------------------
+=== In v0.70 ===
+
+1. +platform_tcl()+ settings are now automatically determined
+2. Add aio `$handle filename`
+3. Add `info channels`
+4. The 'bio' extension is gone. Now `aio` supports 'copyto'.
+5. Add `exists` command
+6. Add the pure-Tcl 'oo' extension
+7. The `exec` command now only uses vfork(), not fork()
+8. Unit test framework is less verbose and more Tcl-compatible
+9. Optional UTF-8 support
+10. Optional built-in regexp engine for better Tcl compatibility and UTF-8 support
+11. Command line editing in interactive mode, e.g. 'jimsh'
+
=== In v0.63 ===
1. `source` now checks that a script is complete (.i.e. not missing a brace)
diff --git a/tests/expr-base.test b/tests/expr-base.test
new file mode 100644
index 0000000..5c9e1da
--- /dev/null
+++ b/tests/expr-base.test
@@ -0,0 +1,39 @@
+source [file dirname [info script]]/testing.tcl
+
+# Test number detection
+set good_testcases {
+ 0 0
+ 1 1
+ 8 8
+ 00 0
+ 07 7
+ 08 8
+ 0x5 5
+ 0x0 0
+ 0x00 0
+ -0x5 -5
+ 0b111 7
+ -0b111 -7
+ -0B101 -5
+ 0o7 7
+}
+
+set i 0
+foreach {str exp} $good_testcases {
+ test expr-base-1.[incr i] "expr conversion" [list expr [list $str]] $exp
+}
+
+set bad_testcases {
+ {0x + 1}
+ x
+ 0xx5
+ 0x-5
+ {0x 5}
+ {0o8 + 1}
+}
+
+set i 0
+foreach str $bad_testcases {
+ test expr-base-2.[incr i] "expr conversion failure" -returnCodes error -body [list expr $str] -match glob -result "*"
+}
+testreport
diff --git a/tests/expr-new.test b/tests/expr-new.test
index 1130eb1..e3c4378 100644
--- a/tests/expr-new.test
+++ b/tests/expr-new.test
@@ -294,7 +294,7 @@ test expr-9.10 {CompileRelationalExpr: error compiling relational arm} {
test expr-10.1 {CompileShiftExpr: just add expr} {expr 4+-2} 2
test expr-10.2 {CompileShiftExpr: just add expr} {expr 0xff-2} 253
test expr-10.3 {CompileShiftExpr: just add expr} {expr -1--2} 1
-test expr-10.4 {CompileShiftExpr: just add expr} {expr 1-0123} -82
+test expr-10.4 {CompileShiftExpr: just add expr} {expr 1-0123} -122
test expr-10.5 {CompileShiftExpr: error in add expr} {
catch {expr x+3} msg
} {1}
@@ -316,7 +316,7 @@ test expr-10.11 {CompileShiftExpr: runtime error} {
test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
test expr-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
-test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0123} 6
+test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0123} 19
test expr-11.5 {CompileAddExpr: error in multiply expr} {
catch {expr x*3} msg
} {1}
@@ -367,7 +367,7 @@ test expr-12.11 {CompileMultiplyExpr: runtime error} {
} {1}
test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
-test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +000123} 83
+test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +000123} 123
test expr-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
test expr-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
test expr-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
@@ -400,7 +400,7 @@ test expr-13.16 {CompileUnaryExpr: error in primary expr} {
test expr-14.1 {CompilePrimaryExpr: literal primary} {expr 1} 1
test expr-14.2 {CompilePrimaryExpr: literal primary} {expr 123} 123
test expr-14.3 {CompilePrimaryExpr: literal primary} {expr 0xff} 255
-test expr-14.4 {CompilePrimaryExpr: literal primary} {expr 00010} 8
+test expr-14.4 {CompilePrimaryExpr: literal primary} {expr 00010} 10
test expr-14.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0
test expr-14.6 {CompilePrimaryExpr: literal primary} {
expr 3.1400000
diff --git a/tests/expr-old.test b/tests/expr-old.test
index c5deb0e..b1d722d 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -375,7 +375,7 @@ test expr-old-23.8 {double quotes} {
# Numbers in various bases.
test expr-old-24.1 {numbers in different bases} {expr 0x20} 32
-test expr-old-24.2 {numbers in different bases} {expr 015} 13
+test expr-old-24.2 {numbers in different bases} {expr 015} 15
# Conversions between various data types.
diff --git a/tests/jim.test b/tests/jim.test
index de675f2..e8c125e 100644
--- a/tests/jim.test
+++ b/tests/jim.test
@@ -159,9 +159,9 @@ test set-1.22 {TclCompileSetCmd: doing assignment, large int} {
test set-1.23 {TclCompileSetCmd: doing assignment, formatted int != int} {
set i 25
- set i 000012345 ;# an octal literal == 5349 decimal
+ set i 000012345 ;# a decimal literal == 5349 decimal
list $i [incr i]
-} {000012345 5350}
+} {000012345 12346}
################################################################################
# LIST
@@ -1268,8 +1268,8 @@ test incr-1.22 {TclCompileIncrCmd: increment given, large int} {
} 200005
test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
set i 25
- incr i 000012345 ;# an octal literal
-} 5374
+ incr i 000012345 ;# a decimal literal
+} 12370
test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
set i 25
catch {incr i 1a} msg
@@ -1488,7 +1488,7 @@ test incr-2.23 {incr command (not compiled): increment given, formatted int != i
set z incr
set i 25
$z i 000012345 ;# an octal literal
-} 5374
+} 12370
test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
set z incr
set i 25
diff --git a/tests/lsort.test b/tests/lsort.test
index a01b14f..ad28b6e 100644
--- a/tests/lsort.test
+++ b/tests/lsort.test
@@ -145,7 +145,7 @@ test lsort-3.10 {SortCompare procedure, -integer option} {
} {1 {expected integer but got "q"}}
test lsort-3.11 {SortCompare procedure, -integer option} {
lsort -integer {35 21 0x20 30 023 100 8}
-} {8 023 21 30 0x20 35 100}
+} {8 21 023 30 0x20 35 100}
test lsort-3.15 {SortCompare procedure, -command option} {
proc cmp {a b} {
error "comparison error"
@@ -172,7 +172,7 @@ test lsort-3.18 {SortCompare procedure, -command option} {
} {48 36 35 22 21 18 6}
test lsort-3.19 {SortCompare procedure, -decreasing option} {
lsort -decreasing -integer {35 21 0x20 30 023 100 8}
-} {100 35 0x20 30 21 023 8}
+} {100 35 0x20 30 023 21 8}
test lsort-4.26 {DefaultCompare procedure, signed characters} utf8 {
set l [lsort [list "abc\u80" "abc"]]
diff --git a/tests/scan.test b/tests/scan.test
index 8bfcbe8..2267d22 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -247,11 +247,11 @@ test scan-4.40.2 {Tcl_ScanObjCmd, base-16 integer scanning} {
test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} {
set x {}
list [scan {10 010 0x10} {%i%i%i} x y z] $x $y $z
-} {3 10 8 16}
+} {3 10 10 16}
test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} {
set x {}
list [scan {10 010 0X10} {%i%i%i} x y z] $x $y $z
-} {3 10 8 16}
+} {3 10 10 16}
test scan-4.43 {Tcl_ScanObjCmd, integer scanning, odd cases} {
set x {}
list [scan {+ } {%i} x] $x
diff --git a/tests/string.test b/tests/string.test
index 9b9b9f4..5b0bbeb 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -336,7 +336,7 @@ test string-6.57 {string is integer, false} {
} 0
test string-6.58 {string is integer, false on bad octal} {
list [string is integer 036963]
-} 0
+} 1
test string-6.59 {string is integer, false on bad hex} {
list [string is integer 0X345XYZ]
} 0
generated by cgit v1.1 at 2024-07-16 17:59:35 +0000