Remove octal literals with a leading 0 (TIP #114)

Now an octal literal needs to be explicitly indicated with a leading
0o or 0O, otherwise the number is treated as decimal.

This patch also adds support for binary literals.
e.g. 0b101 0B1101

Signed-off-by: Steve Bennett <steveb@workware.net.au>

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