summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclScan.c21
-rw-r--r--generic/tclStringObj.c14
-rw-r--r--tests/format.test6
-rw-r--r--tests/scan.test13
4 files changed, 41 insertions, 13 deletions
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 3edb8be..5ea7e46 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -10,6 +10,7 @@
*/
#include "tclInt.h"
+#include "tommath.h"
/*
* Flag values used by Tcl_ScanObjCmd.
@@ -415,14 +416,7 @@ ValidateFormat(
case 'x':
case 'X':
case 'b':
- break;
case 'u':
- if (flags & SCAN_BIG) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unsigned bignum scans are invalid", -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
- goto error;
- }
break;
/*
* Bracket terms need special checking
@@ -936,7 +930,18 @@ Tcl_ScanObjCmd(
} else {
Tcl_SetWideIntObj(objPtr, wideValue);
}
- } else if (!(flags & SCAN_BIG)) {
+ } else if (flags & SCAN_BIG) {
+ if (flags & SCAN_UNSIGNED) {
+ mp_int big;
+ if ((Tcl_GetBignumFromObj(interp, objPtr, &big) != TCL_OK)
+ || (mp_cmp_d(&big, 0) == MP_LT)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unsigned bignum scans are invalid", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
+ return TCL_ERROR;
+ }
+ }
+ } else {
if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
if (TclGetString(objPtr)[0] == '-') {
value = LONG_MIN;
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 560c169..e51b98a 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1939,11 +1939,6 @@ Tcl_AppendFormatToObj(
}
case 'u':
- if (useBig) {
- msg = "unsigned bignum format is invalid";
- errCode = "BADUNSIGNED";
- goto errorMsg;
- }
case 'd':
case 'o':
case 'p':
@@ -1967,6 +1962,15 @@ Tcl_AppendFormatToObj(
goto error;
}
isNegative = (mp_cmp_d(&big, 0) == MP_LT);
+ if (ch == 'u') {
+ if (isNegative) {
+ msg = "unsigned bignum format is invalid";
+ errCode = "BADUNSIGNED";
+ goto errorMsg;
+ } else {
+ ch = 'd';
+ }
+ }
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
diff --git a/tests/format.test b/tests/format.test
index 00b6939..a4ea25e 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -549,6 +549,12 @@ test format-17.3 {testing %ld with non-wide} {wideIs64bit} {
test format-17.4 {testing %l with non-integer} {
format %lf 1
} 1.000000
+test format-17.5 {testing %llu with bignum} {
+ format %llu 0xabcdef0123456789abcdef
+} 207698809136909011942886895
+test format-17.6 {testing %llu with negative number} -body {
+ format %llu -1
+} -returnCodes 1 -result {unsigned bignum format is invalid}
test format-18.1 {do not demote existing numeric values} {
set a 0xaaaaaaaa
diff --git a/tests/scan.test b/tests/scan.test
index 7540c9c..8ddb595 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -541,6 +541,19 @@ test scan-5.15 {Bug be003d570f} {
test scan-5.16 {Bug be003d570f} {
scan 0x40 %b
} 0
+test scan-5.17 {bigint scanning} -setup {
+ set a {}; set b {}; set c {}; set d {}
+} -body {
+ list [scan "207698809136909011942886895,207698809136909011942886895,abcdef0123456789abcdef,125715736004432126361152746757" \
+ %llu,%lld,%llx,%llo a b c d] $a $b $c $d
+} -result {4 207698809136909011942886895 207698809136909011942886895 207698809136909011942886895 207698809136909011942886895}
+test scan-5.18 {bigint scanning underflow} -setup {
+ set a {};
+} -body {
+ list [scan "-207698809136909011942886895" \
+ %llu a] $a
+} -returnCodes 1 -result {unsigned bignum scans are invalid}
+
test scan-6.1 {floating-point scanning} -setup {
set a {}; set b {}; set c {}; set d {}