Attachment "tip114.patch" to
ticket [1805896fff]
added by
dgp
2007-10-02 02:55:06.
Index: generic/tclCompExpr.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompExpr.c,v
retrieving revision 1.86
diff -u -r1.86 tclCompExpr.c
--- generic/tclCompExpr.c 28 Aug 2007 17:43:07 -0000 1.86
+++ generic/tclCompExpr.c 1 Oct 2007 19:31:50 -0000
@@ -744,6 +744,29 @@
" or \"%.*s%s(...)\" or ...",
(scanned < limit) ? scanned : limit - 3,
start, (scanned < limit) ? "" : "...");
+ if (NotOperator(lastParsed)) {
+ if ((lastStart[0] == '0')
+ && ((lastStart[1] == 'o')
+ || (lastStart[1] == 'O'))
+ && (lastStart[2] >= '0')
+ && (lastStart[2] <= '9')) {
+ const char *end = lastStart + 2;
+ while (isdigit(*end)) {
+ end++;
+ }
+ Tcl_Obj *copy = Tcl_NewStringObj(lastStart,
+ end - lastStart);
+ if (TclCheckBadOctal(NULL,
+ Tcl_GetString(copy))) {
+ TclNewLiteralStringObj(post,
+ "(invalid octal number?)");
+ }
+ Tcl_DecrRefCount(copy);
+ }
+ scanned = 0;
+ insertMark = 1;
+ parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
+ }
goto error;
}
}
Index: generic/tclIOCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOCmd.c,v
retrieving revision 1.43
diff -u -r1.43 tclIOCmd.c
--- generic/tclIOCmd.c 6 Sep 2007 18:13:20 -0000 1.43
+++ generic/tclIOCmd.c 1 Oct 2007 19:31:50 -0000
@@ -1025,7 +1025,25 @@
} else {
modeString = Tcl_GetString(objv[2]);
if (objc == 4) {
- if (Tcl_GetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
+ char *permString = TclGetString(objv[3]);
+ int code = TCL_ERROR;
+ int scanned = TclParseAllWhiteSpace(permString, -1);
+
+ /* Support legacy octal numbers */
+ if ((permString[scanned] == '0')
+ && (permString[scanned+1] >= '0')
+ && (permString[scanned+1] <= '7')) {
+
+ Tcl_Obj *permObj;
+
+ TclNewLiteralStringObj(permObj, "0o");
+ Tcl_AppendToObj(permObj, permString+scanned+1, -1);
+ code = Tcl_GetIntFromObj(NULL, permObj, &prot);
+ Tcl_DecrRefCount(permObj);
+ }
+
+ if ((code == TCL_ERROR)
+ && Tcl_GetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
return TCL_ERROR;
}
}
Index: generic/tclStrToD.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStrToD.c,v
retrieving revision 1.30
diff -u -r1.30 tclStrToD.c
--- generic/tclStrToD.c 23 Apr 2007 17:34:07 -0000 1.30
+++ generic/tclStrToD.c 1 Oct 2007 19:31:51 -0000
@@ -33,7 +33,7 @@
* as octal. (Ceterum censeo: numeros octonarios delendos esse.)
*/
-#undef KILL_OCTAL
+#define KILL_OCTAL
/*
* This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754
Index: generic/tclUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtil.c,v
retrieving revision 1.82
diff -u -r1.82 tclUtil.c
--- generic/tclUtil.c 7 May 2007 19:45:33 -0000 1.82
+++ generic/tclUtil.c 1 Oct 2007 19:31:51 -0000
@@ -2372,8 +2372,8 @@
Tcl_AppendResult(interp, "bad index \"", bytes,
"\": must be integer?[+-]integer? or end?[+-]integer?",
(char *) NULL);
- if (!strncmp(bytes, "end-", 3)) {
- bytes += 3;
+ if (!strncmp(bytes, "end-", 4)) {
+ bytes += 4;
}
TclCheckBadOctal(interp, bytes);
}
@@ -2556,6 +2556,9 @@
p++;
}
if (*p == '0') {
+ if ((p[1] == 'o') || p[1] == 'O') {
+ p+=2;
+ }
while (isdigit(UCHAR(*p))) { /* INTL: digit. */
p++;
}
Index: tests/cmdAH.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/cmdAH.test,v
retrieving revision 1.55
diff -u -r1.55 cmdAH.test
--- tests/cmdAH.test 18 Jan 2007 22:09:44 -0000 1.55
+++ tests/cmdAH.test 1 Oct 2007 19:31:52 -0000
@@ -1332,7 +1332,7 @@
test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unix} {
catch {unset stat}
file stat $gorpfile stat
- expr $stat(mode)&0777
+ expr $stat(mode)&0o777
} {501}
test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
string tolower [list [catch {file stat _bogus_ stat} msg] \
Index: tests/cmdIL.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/cmdIL.test,v
retrieving revision 1.33
diff -u -r1.33 cmdIL.test
--- tests/cmdIL.test 13 Mar 2007 17:34:04 -0000 1.33
+++ tests/cmdIL.test 1 Oct 2007 19:31:53 -0000
@@ -195,8 +195,8 @@
list [catch {lsort -integer {3 q}} msg] $msg
} {1 {expected integer but got "q"}}
test cmdIL-3.11 {SortCompare procedure, -integer option} {
- lsort -integer {35 21 0x20 30 023 100 8}
-} {8 023 21 30 0x20 35 100}
+ lsort -integer {35 21 0x20 30 0o23 100 8}
+} {8 0o23 21 30 0x20 35 100}
test cmdIL-3.12 {SortCompare procedure, -real option} {
list [catch {lsort -real {6...4 3}} msg] $msg
} {1 {expected floating-point number but got "6...4"}}
@@ -247,8 +247,8 @@
rename cmp ""
} -result {48 36 35 22 21 18 6}
test cmdIL-3.19 {SortCompare procedure, -decreasing option} {
- lsort -decreasing -integer {35 21 0x20 30 023 100 8}
-} {100 35 0x20 30 21 023 8}
+ lsort -decreasing -integer {35 21 0x20 30 0o23 100 8}
+} {100 35 0x20 30 21 0o23 8}
test cmdIL-4.1 {DictionaryCompare procedure, numerics, leading zeros} {
lsort -dictionary {a003b a03b}
Index: tests/compExpr-old.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/compExpr-old.test,v
retrieving revision 1.21
diff -u -r1.21 compExpr-old.test
--- tests/compExpr-old.test 9 Oct 2006 19:15:44 -0000 1.21
+++ tests/compExpr-old.test 1 Oct 2007 19:31:53 -0000
@@ -362,7 +362,7 @@
test compExpr-old-10.1 {CompileShiftExpr: just add expr} {expr 4+-2} 2
test compExpr-old-10.2 {CompileShiftExpr: just add expr} {expr 0xff-2} 253
test compExpr-old-10.3 {CompileShiftExpr: just add expr} {expr -1--2} 1
-test compExpr-old-10.4 {CompileShiftExpr: just add expr} {expr 1-0123} -82
+test compExpr-old-10.4 {CompileShiftExpr: just add expr} {expr 1-0o123} -82
test compExpr-old-10.5 {CompileShiftExpr: error in add expr} -body {
expr x+3
} -returnCodes error -match glob -result *
@@ -384,7 +384,7 @@
test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
test compExpr-old-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
-test compExpr-old-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0123} 6
+test compExpr-old-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6
test compExpr-old-11.5 {CompileAddExpr: error in multiply expr} -body {
expr x*3
} -returnCodes error -match glob -result *
@@ -435,7 +435,7 @@
} {1 {can't use non-numeric string as operand of "/"}}
test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
-test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +000123} 83
+test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
test compExpr-old-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
test compExpr-old-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
test compExpr-old-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
@@ -470,7 +470,7 @@
test compExpr-old-14.1 {CompilePrimaryExpr: literal primary} {expr 1} 1
test compExpr-old-14.2 {CompilePrimaryExpr: literal primary} {expr 123} 123
test compExpr-old-14.3 {CompilePrimaryExpr: literal primary} {expr 0xff} 255
-test compExpr-old-14.4 {CompilePrimaryExpr: literal primary} {expr 00010} 8
+test compExpr-old-14.4 {CompilePrimaryExpr: literal primary} {expr 0o0010} 8
test compExpr-old-14.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0
test compExpr-old-14.6 {CompilePrimaryExpr: literal primary} {
expr 3.1400000
Index: tests/compExpr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/compExpr.test,v
retrieving revision 1.14
diff -u -r1.14 compExpr.test
--- tests/compExpr.test 24 Aug 2007 21:34:20 -0000 1.14
+++ tests/compExpr.test 1 Oct 2007 19:31:53 -0000
@@ -37,7 +37,7 @@
} -match glob -result {1 {* "*foo"}}
test compExpr-1.4 {TclCompileExpr procedure, expr has no operators} {
- set a {000123}
+ set a {0o00123}
expr {$a}
} 83
@@ -283,7 +283,7 @@
} nope
test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} {
catch {unset a}
- set a 00123
+ set a 0o0123
expr {0? 42 : $a}
} 83
test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} {
Index: tests/compile.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/compile.test,v
retrieving revision 1.46
diff -u -r1.46 compile.test
--- tests/compile.test 7 Mar 2007 19:16:05 -0000 1.46
+++ tests/compile.test 1 Oct 2007 19:31:53 -0000
@@ -241,10 +241,10 @@
proc p {} { set r [list foobar] ; string index a bogus }
list [catch {p} msg] $msg
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
-test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
- proc p {} { set r [list foobar] ; string index a 09 }
+test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+ proc p {} { set r [list foobar] ; string index a 0o9 }
list [catch {p} msg] $msg
-} {1 {bad index "09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
+} -match glob -result {1 {*invalid octal number*}}
test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
proc p {} { set r [list foobar] ; array set var {one two many} }
list [catch {p} msg] $msg
Index: tests/expr-old.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/expr-old.test,v
retrieving revision 1.38
diff -u -r1.38 expr-old.test
--- tests/expr-old.test 31 Aug 2006 20:09:19 -0000 1.38
+++ tests/expr-old.test 1 Oct 2007 19:31:54 -0000
@@ -465,7 +465,7 @@
# 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 0o15} 13
# Conversions between various data types.
@@ -678,7 +678,7 @@
# Operands enclosed in braces
test expr-old-29.1 {braces} {expr {{abc}}} abc
-test expr-old-29.2 {braces} {expr {{00010}}} 8
+test expr-old-29.2 {braces} {expr {{0o0010}}} 8
test expr-old-29.3 {braces} {expr {{3.1200000}}} 3.12
test expr-old-29.4 {braces} {expr {{a{b}{1 {2 3}}c}}} "a{b}{1 {2 3}}c"
test expr-old-29.5 {braces} -body {
@@ -959,10 +959,10 @@
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
- expr 0289
+ expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
- set x 0289
+ set x 0o289
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
@@ -1014,7 +1014,7 @@
expr {$x+1}
} 123456789012345678901234567891
test expr-old-36.15 {ExprLooksLikeInt procedure} {
- set x "099 "
+ set x "0o99 "
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.16 {ExprLooksLikeInt procedure} {
Index: tests/expr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/expr.test,v
retrieving revision 1.69
diff -u -r1.69 expr.test
--- tests/expr.test 25 Aug 2007 03:23:18 -0000 1.69
+++ tests/expr.test 1 Oct 2007 19:31:57 -0000
@@ -441,7 +441,7 @@
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-0o123} -82
test expr-10.5 {CompileShiftExpr: error in add expr} -body {
expr x+3
} -returnCodes error -match glob -result *
@@ -463,7 +463,7 @@
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%0o123} 6
test expr-11.5 {CompileAddExpr: error in multiply expr} -body {
expr x*3
} -returnCodes error -match glob -result *
@@ -514,7 +514,7 @@
} {1 {can't use non-numeric string as operand of "/"}}
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 +0o00123} 83
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
@@ -553,7 +553,7 @@
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 0o0010} 8
test expr-14.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0
test expr-14.6 {CompilePrimaryExpr: literal primary} {
expr 3.1400000
@@ -6452,10 +6452,10 @@
} {1 {domain error: argument not in valid range}}
test expr-40.1 {large octal shift} {
- expr 0100000000000000000000000000000000
+ expr 0o100000000000000000000000000000000
} [expr 0x1000000000000000000000000]
test expr-40.2 {large octal shift} {
- expr 0100000000000000000000000000000001
+ expr 0o100000000000000000000000000000001
} [expr 0x1000000000000000000000001]
test expr-41.1 {exponent overflow} {
Index: tests/incr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/incr.test,v
retrieving revision 1.14
diff -u -r1.14 incr.test
--- tests/incr.test 9 Oct 2006 19:15:44 -0000 1.14
+++ tests/incr.test 1 Oct 2007 19:31:57 -0000
@@ -194,7 +194,7 @@
} 200005
test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
set i 25
- incr i 000012345 ;# an octal literal
+ incr i 0o00012345 ;# an octal literal
} 5374
test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
set i 25
@@ -445,7 +445,7 @@
test incr-2.23 {incr command (not compiled): increment given, formatted int != int} {
set z incr
set i 25
- $z i 000012345 ;# an octal literal
+ $z i 0o00012345 ;# an octal literal
} 5374
test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
set z incr
Index: tests/io.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/io.test,v
retrieving revision 1.76
diff -u -r1.76 io.test
--- tests/io.test 4 May 2007 14:59:06 -0000 1.76
+++ tests/io.test 1 Oct 2007 19:31:59 -0000
@@ -48,7 +48,7 @@
# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.
set umaskValue 0
-testConstraint umask [expr {![catch {set umaskValue [exec /bin/sh -c umask]}]}]
+testConstraint umask [expr {![catch {set umaskValue [scan [exec /bin/sh -c umask] %o]}]}]
testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}]
@@ -5209,7 +5209,7 @@
file delete $path(test3)
set f [open $path(test3) {WRONLY CREAT} 0600]
file stat $path(test3) stats
- set x [format "0%o" [expr $stats(mode)&0777]]
+ set x [format "0%o" [expr $stats(mode)&0o777]]
puts $f "line 1"
close $f
set f [open $path(test3) r]
@@ -5223,8 +5223,8 @@
set f [open $path(test3) {WRONLY CREAT}]
close $f
file stat $path(test3) stats
- format "0%o" [expr $stats(mode)&0777]
-} [format %04o [expr {0666 & ~ $umaskValue}]]
+ format "0%o" [expr $stats(mode)&0o777]
+} [format %04o [expr {0o666 & ~ $umaskValue}]]
test io-40.4 {POSIX open access modes: CREAT} {
file delete $path(test3)
set f [open $path(test3) w]
Index: tests/lindex.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/lindex.test,v
retrieving revision 1.15
diff -u -r1.15 lindex.test
--- tests/lindex.test 3 Sep 2007 21:27:22 -0000 1.15
+++ tests/lindex.test 1 Oct 2007 19:31:59 -0000
@@ -15,7 +15,7 @@
# RCS: @(#) $Id: lindex.test,v 1.15 2007/09/03 21:27:22 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2.2
namespace import -force ::tcltest::*
}
@@ -66,14 +66,14 @@
set x [string range 33 0 0]
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
-test lindex-3.5 {bad octal} testevalex {
- set x 08
+test lindex-3.5 {bad octal} -constraints testevalex -body {
+ set x 0o8
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-test lindex-3.6 {bad octal} testevalex {
- set x -09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-3.6 {bad octal} -constraints testevalex -body {
+ set x -0o9
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
+} -match glob -result {1 {*invalid octal number*}}
test lindex-3.7 {indexes don't shimmer wide ints} {
set x [expr {(wide(1)<<31) - 2}]
list $x [lindex {1 2 3} $x] [incr x] [incr x]
@@ -101,14 +101,14 @@
set x end-3
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
-test lindex-4.6 {bad octal} testevalex {
- set x end-08
+test lindex-4.6 {bad octal} -constraints testevalex -body {
+ set x end-0o8
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-test lindex-4.7 {bad octal} testevalex {
- set x end--09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-4.7 {bad octal} -constraints testevalex -body {
+ set x end--0o9
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}}
+} -match glob -result {1 {*invalid octal number*}}
test lindex-4.8 {bad integer, not octal} testevalex {
set x end-0a2
list [catch { testevalex {lindex {a b c} $x} } result] $result
@@ -257,14 +257,14 @@
} result
set result
} {{} {}}
-test lindex-11.5 {bad octal} {
- set x 08
+test lindex-11.5 {bad octal} -body {
+ set x 0o8
list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-test lindex-11.6 {bad octal} {
- set x -09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-11.6 {bad octal} -body {
+ set x -0o9
list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
+} -match glob -result {1 {*invalid octal number*}}
# Indices relative to end
@@ -303,14 +303,14 @@
} result
set result
} {{} {}}
-test lindex-12.6 {bad octal} {
- set x end-08
+test lindex-12.6 {bad octal} -body {
+ set x end-0o8
list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-test lindex-12.7 {bad octal} {
- set x end--09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-12.7 {bad octal} -body {
+ set x end--0o9
list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}}
+} -match glob -result {1 {*invalid octal number*}}
test lindex-12.8 {bad integer, not octal} {
set x end-0a2
list [catch { lindex {a b c} $x } result] $result
Index: tests/link.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/link.test,v
retrieving revision 1.15
diff -u -r1.15 link.test
--- tests/link.test 21 Mar 2006 11:12:29 -0000 1.15
+++ tests/link.test 1 Oct 2007 19:31:59 -0000
@@ -40,7 +40,7 @@
testlink delete
testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
- set int "00721"
+ set int "0o0721"
set real -10.5
set bool true
set string abcdef
@@ -55,7 +55,7 @@
set float 1.0987654321
set uwide 357357357357
concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 00721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357}
+} {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357}
test link-2.2 {writing bad values into variables} {testlink} {
testlink delete
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
Index: tests/mathop.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/mathop.test,v
retrieving revision 1.9
diff -u -r1.9 mathop.test
--- tests/mathop.test 9 Sep 2007 16:51:19 -0000 1.9
+++ tests/mathop.test 1 Oct 2007 19:31:59 -0000
@@ -127,10 +127,10 @@
+ 0 nan
} -result {can't use non-numeric floating-point value as operand of "+"}
test mathop-1.15 {compiled +: errors} -returnCodes error -body {
- + 08 0
+ + 0o8 0
} -result {can't use invalid octal number as operand of "+"}
test mathop-1.16 {compiled +: errors} -returnCodes error -body {
- + 0 08
+ + 0 0o8
} -result {can't use invalid octal number as operand of "+"}
test mathop-1.17 {compiled +: errors} -returnCodes error -body {
+ 0 [error expectedError]
@@ -165,10 +165,10 @@
$op 0 nan
} -result {can't use non-numeric floating-point value as operand of "+"}
test mathop-1.33 {interpreted +: errors} -returnCodes error -body {
- $op 08 0
+ $op 0o8 0
} -result {can't use invalid octal number as operand of "+"}
test mathop-1.34 {interpreted +: errors} -returnCodes error -body {
- $op 0 08
+ $op 0 0o8
} -result {can't use invalid octal number as operand of "+"}
test mathop-1.35 {interpreted +: errors} -returnCodes error -body {
$op 0 [error expectedError]
@@ -202,10 +202,10 @@
* 0 nan
} -result {can't use non-numeric floating-point value as operand of "*"}
test mathop-2.15 {compiled *: errors} -returnCodes error -body {
- * 08 0
+ * 0o8 0
} -result {can't use invalid octal number as operand of "*"}
test mathop-2.16 {compiled *: errors} -returnCodes error -body {
- * 0 08
+ * 0 0o8
} -result {can't use invalid octal number as operand of "*"}
test mathop-2.17 {compiled *: errors} -returnCodes error -body {
* 0 [error expectedError]
@@ -240,10 +240,10 @@
$op 0 nan
} -result {can't use non-numeric floating-point value as operand of "*"}
test mathop-2.33 {interpreted *: errors} -returnCodes error -body {
- $op 08 0
+ $op 0o8 0
} -result {can't use invalid octal number as operand of "*"}
test mathop-2.34 {interpreted *: errors} -returnCodes error -body {
- $op 0 08
+ $op 0 0o8
} -result {can't use invalid octal number as operand of "*"}
test mathop-2.35 {interpreted *: errors} -returnCodes error -body {
$op 0 [error expectedError]
@@ -384,9 +384,9 @@
& 1 2 3.0
} -result {can't use floating-point value as operand of "&"}
test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2
- test mathop-6.8 {compiled &} { & 0xff 0377 333333333333 } 85
+ test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85
test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2
- test mathop-6.10 {compiled &} { & 0xff 0377 3333333333333333333333 } 85
+ test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85
test mathop-6.11 {compiled &: errors} -returnCodes error -body {
& x 0
} -result {can't use non-numeric string as operand of "&"}
@@ -400,10 +400,10 @@
& 0 nan
} -result {can't use non-numeric floating-point value as operand of "&"}
test mathop-6.15 {compiled &: errors} -returnCodes error -body {
- & 08 0
+ & 0o8 0
} -result {can't use invalid octal number as operand of "&"}
test mathop-6.16 {compiled &: errors} -returnCodes error -body {
- & 0 08
+ & 0 0o8
} -result {can't use invalid octal number as operand of "&"}
test mathop-6.17 {compiled &: errors} -returnCodes error -body {
& 0 [error expectedError]
@@ -426,9 +426,9 @@
$op 1 2 3.0
} -result {can't use floating-point value as operand of "&"}
test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2
- test mathop-6.26 {interpreted &} { $op 0xff 0377 333333333333 } 85
+ test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85
test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2
- test mathop-6.28 {interpreted &} { $op 0xff 0377 3333333333333333333333 } 85
+ test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85
test mathop-6.29 {interpreted &: errors} -returnCodes error -body {
$op x 0
} -result {can't use non-numeric string as operand of "&"}
@@ -442,10 +442,10 @@
$op 0 nan
} -result {can't use non-numeric floating-point value as operand of "&"}
test mathop-6.33 {interpreted &: errors} -returnCodes error -body {
- $op 08 0
+ $op 0o8 0
} -result {can't use invalid octal number as operand of "&"}
test mathop-6.34 {interpreted &: errors} -returnCodes error -body {
- $op 0 08
+ $op 0 0o8
} -result {can't use invalid octal number as operand of "&"}
test mathop-6.35 {interpreted &: errors} -returnCodes error -body {
$op 0 [error expectedError]
@@ -494,9 +494,9 @@
| 1 2 3.0
} -result {can't use floating-point value as operand of "|"}
test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110
- test mathop-7.8 {compiled |} { | 0xff 0377 333333333333 } 333333333503
+ test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503
test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110
- test mathop-7.10 {compiled |} { | 0xff 0377 3333333333333333333333 } 3333333333333333333503
+ test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503
test mathop-7.11 {compiled |: errors} -returnCodes error -body {
| x 0
} -result {can't use non-numeric string as operand of "|"}
@@ -510,10 +510,10 @@
| 0 nan
} -result {can't use non-numeric floating-point value as operand of "|"}
test mathop-7.15 {compiled |: errors} -returnCodes error -body {
- | 08 0
+ | 0o8 0
} -result {can't use invalid octal number as operand of "|"}
test mathop-7.16 {compiled |: errors} -returnCodes error -body {
- | 0 08
+ | 0 0o8
} -result {can't use invalid octal number as operand of "|"}
test mathop-7.17 {compiled |: errors} -returnCodes error -body {
| 0 [error expectedError]
@@ -536,9 +536,9 @@
$op 1 2 3.0
} -result {can't use floating-point value as operand of "|"}
test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110
- test mathop-7.26 {interpreted |} { $op 0xff 0377 333333333333 } 333333333503
+ test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503
test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110
- test mathop-7.28 {interpreted |} { $op 0xff 0377 3333333333333333333333 } 3333333333333333333503
+ test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503
test mathop-7.29 {interpreted |: errors} -returnCodes error -body {
$op x 0
} -result {can't use non-numeric string as operand of "|"}
@@ -552,10 +552,10 @@
$op 0 nan
} -result {can't use non-numeric floating-point value as operand of "|"}
test mathop-7.33 {interpreted |: errors} -returnCodes error -body {
- $op 08 0
+ $op 0o8 0
} -result {can't use invalid octal number as operand of "|"}
test mathop-7.34 {interpreted |: errors} -returnCodes error -body {
- $op 0 08
+ $op 0 0o8
} -result {can't use invalid octal number as operand of "|"}
test mathop-7.35 {interpreted |: errors} -returnCodes error -body {
$op 0 [error expectedError]
@@ -604,9 +604,9 @@
^ 1 2 3.0
} -result {can't use floating-point value as operand of "^"}
test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110
- test mathop-8.8 {compiled ^} { ^ 0xff 0377 333333333333 } 333333333333
+ test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333
test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110
- test mathop-8.10 {compiled ^} { ^ 0xff 0377 3333333333333333333333 } 3333333333333333333333
+ test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333
test mathop-8.11 {compiled ^: errors} -returnCodes error -body {
^ x 0
} -result {can't use non-numeric string as operand of "^"}
@@ -620,10 +620,10 @@
^ 0 nan
} -result {can't use non-numeric floating-point value as operand of "^"}
test mathop-8.15 {compiled ^: errors} -returnCodes error -body {
- ^ 08 0
+ ^ 0o8 0
} -result {can't use invalid octal number as operand of "^"}
test mathop-8.16 {compiled ^: errors} -returnCodes error -body {
- ^ 0 08
+ ^ 0 0o8
} -result {can't use invalid octal number as operand of "^"}
test mathop-8.17 {compiled ^: errors} -returnCodes error -body {
^ 0 [error expectedError]
@@ -646,9 +646,9 @@
$op 1 2 3.0
} -result {can't use floating-point value as operand of "^"}
test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110
- test mathop-8.26 {interpreted ^} { $op 0xff 0377 333333333333 } 333333333333
+ test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333
test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110
- test mathop-8.28 {interpreted ^} { $op 0xff 0377 3333333333333333333333 } 3333333333333333333333
+ test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333
test mathop-8.29 {interpreted ^: errors} -returnCodes error -body {
$op x 0
} -result {can't use non-numeric string as operand of "^"}
@@ -662,10 +662,10 @@
$op 0 nan
} -result {can't use non-numeric floating-point value as operand of "^"}
test mathop-8.33 {interpreted ^: errors} -returnCodes error -body {
- $op 08 0
+ $op 0o8 0
} -result {can't use invalid octal number as operand of "^"}
test mathop-8.34 {interpreted ^: errors} -returnCodes error -body {
- $op 0 08
+ $op 0 0o8
} -result {can't use invalid octal number as operand of "^"}
test mathop-8.35 {interpreted ^: errors} -returnCodes error -body {
$op 0 [error expectedError]
Index: tests/parseExpr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/parseExpr.test,v
retrieving revision 1.27
diff -u -r1.27 parseExpr.test
--- tests/parseExpr.test 6 Aug 2007 20:21:00 -0000 1.27
+++ tests/parseExpr.test 1 Oct 2007 19:32:00 -0000
@@ -590,7 +590,7 @@
testexprparser {12345678901234567890} -1
} {- {} 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
test parseExpr-16.6 {GetLexeme procedure, bad integer lexeme} -constraints testexprparser -body {
- testexprparser {0999} -1
+ testexprparser {0o999} -1
} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-16.7 {GetLexeme procedure, double lexeme} testexprparser {
testexprparser {0.999} -1
@@ -762,15 +762,11 @@
} -returnCodes error -result {missing operator at _@_
in expression "0 _@_0"}
test parseExpr-21.7 {error messages} -body {
- expr {08}
-} -returnCodes error -result {missing operator at _@_
-in expression "0_@_8";
-looks like invalid octal number}
+ expr {0o8}
+} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-21.8 {error messages} -body {
- expr {08x}
-} -returnCodes error -result {missing operator at _@_
-in expression "0_@_8x";
-looks like invalid octal number}
+ expr {0o8x}
+} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-21.9 {error messages} -body {
expr {"}
} -returnCodes error -result {missing "
Index: tests/set.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/set.test,v
retrieving revision 1.11
diff -u -r1.11 set.test
--- tests/set.test 9 Oct 2006 19:15:45 -0000 1.11
+++ tests/set.test 1 Oct 2007 19:32:00 -0000
@@ -190,9 +190,9 @@
} 200000
test set-1.23 {TclCompileSetCmd: doing assignment, formatted int != int} {
set i 25
- set i 000012345 ;# an octal literal == 5349 decimal
+ set i 0o00012345 ;# an octal literal == 5349 decimal
list $i [incr i]
-} {000012345 5350}
+} {0o00012345 5350}
test set-1.24 {TclCompileSetCmd: too many arguments} {
set i 10
@@ -465,9 +465,9 @@
test set-3.23 {uncompiled set command: doing assignment, formatted int != int} {
set z set
$z i 25
- $z i 000012345 ;# an octal literal == 5349 decimal
+ $z i 0o00012345 ;# an octal literal == 5349 decimal
list $i [incr i]
-} {000012345 5350}
+} {0o00012345 5350}
test set-3.24 {uncompiled set command: too many arguments} {
set z set
Index: tests/string.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/string.test,v
retrieving revision 1.63
diff -u -r1.63 string.test
--- tests/string.test 8 Jun 2007 20:56:42 -0000 1.63
+++ tests/string.test 1 Oct 2007 19:32:00 -0000
@@ -274,12 +274,12 @@
binary scan $str H* dump
string compare [string index $str 10] \x00
} 0
-test string-5.17 {string index, bad integer} {
- list [catch {string index "abc" 08} msg] $msg
-} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-test string-5.18 {string index, bad integer} {
- list [catch {string index "abc" end-00289} msg] $msg
-} {1 {bad index "end-00289": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
+test string-5.17 {string index, bad integer} -body {
+ list [catch {string index "abc" 0o8} msg] $msg
+} -match glob -result {1 {*invalid octal number*}}
+test string-5.18 {string index, bad integer} -body {
+ list [catch {string index "abc" end-0o0289} msg] $msg
+} -match glob -result {1 {*invalid octal number*}}
test string-5.19 {string index, bytearray object out of bounds} {
string index [binary format I* {0x50515253 0x52}] -1
} {}
@@ -480,7 +480,7 @@
list [string is integer -fail var " "] $var
} {0 0}
test string-6.58 {string is integer, false on bad octal} {
- list [string is integer -fail var 036963] $var
+ list [string is integer -fail var 0o36963] $var
} {0 3}
test string-6.59 {string is integer, false on bad hex} {
list [string is integer -fail var 0X345XYZ] $var
@@ -647,7 +647,7 @@
list [string is wideinteger -fail var " "] $var
} {0 0}
test string-6.105 {string is wideinteger, false on bad octal} {
- list [string is wideinteger -fail var 036963] $var
+ list [string is wideinteger -fail var 0o36963] $var
} {0 3}
test string-6.106 {string is wideinteger, false on bad hex} {
list [string is wideinteger -fail var 0X345XYZ] $var
Index: tests/stringComp.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/stringComp.test,v
retrieving revision 1.12
diff -u -r1.12 stringComp.test
--- tests/stringComp.test 8 Jun 2007 20:56:42 -0000 1.12
+++ tests/stringComp.test 1 Oct 2007 19:32:00 -0000
@@ -349,14 +349,14 @@
}
foo
} 0
-test stringComp-5.17 {string index, bad integer} {
- proc foo {} {string index "abc" 08}
+test stringComp-5.17 {string index, bad integer} -body {
+ proc foo {} {string index "abc" 0o8}
list [catch {foo} msg] $msg
-} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-test stringComp-5.18 {string index, bad integer} {
- proc foo {} {string index "abc" end-00289}
+} -match glob -result {1 {*invalid octal number*}}
+test stringComp-5.18 {string index, bad integer} -body {
+ proc foo {} {string index "abc" end-0o0289}
list [catch {foo} msg] $msg
-} {1 {bad index "end-00289": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
+} -match glob -result {1 {*invalid octal number*}}
test stringComp-5.19 {string index, bytearray object out of bounds} {
proc foo {} {string index [binary format I* {0x50515253 0x52}] -1}
foo
Index: unix/tclUnixFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFCmd.c,v
retrieving revision 1.62
diff -u -r1.62 tclUnixFCmd.c
--- unix/tclUnixFCmd.c 31 Jul 2007 13:57:15 -0000 1.62
+++ unix/tclUnixFCmd.c 1 Oct 2007 19:32:01 -0000
@@ -1595,18 +1595,31 @@
{
long mode;
mode_t newMode;
- int result;
+ int result = TCL_ERROR;
CONST char *native;
+ char *modeStringPtr = TclGetString(attributePtr);
+ int scanned = TclParseAllWhiteSpace(modeStringPtr, -1);
/*
- * First try if the string is a number
+ * First supply support for octal number format
*/
- if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
+ if ((modeStringPtr[scanned] == '0')
+ && (modeStringPtr[scanned+1] >= '0')
+ && (modeStringPtr[scanned+1] <= '7')) {
+ /* Leading zero - attempt octal interpretation */
+ Tcl_Obj *modeObj;
+
+ TclNewLiteralStringObj(modeObj, "0o");
+ Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1);
+ result = Tcl_GetLongFromObj(NULL, modeObj, &mode);
+ Tcl_DecrRefCount(modeObj);
+ }
+ if (result == TCL_OK
+ || Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
newMode = (mode_t) (mode & 0x00007FFF);
} else {
Tcl_StatBuf buf;
- char *modeStringPtr = TclGetString(attributePtr);
/*
* Try the forms "rwxrwxrwx" and "ugo=rwx"
