summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--changes2
-rw-r--r--generic/tclBinary.c11
-rw-r--r--generic/tclCmdMZ.c7
-rw-r--r--generic/tclOOInfo.c14
-rw-r--r--generic/tclOOMethod.c6
-rw-r--r--generic/tclPathObj.c1
-rw-r--r--generic/tclStringObj.c13
-rw-r--r--generic/tclZlib.c2
-rw-r--r--tests/binary.test40
9 files changed, 73 insertions, 23 deletions
diff --git a/changes b/changes
index 9291f9f..f8a8f96 100644
--- a/changes
+++ b/changes
@@ -8891,6 +8891,8 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
2018-11-09 (bug)[35a8f1] overlong string length of some lists (owens)
+2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres)
+
- Released 8.6.9, November 16, 2018 - details at http://core.tcl-lang.org/tcl/ -
Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7,
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 4a03905..0267fcb 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -3044,6 +3044,11 @@ BinaryDecode64(
} else if (i > 1) {
c = '=';
} else {
+ if (strict && i <= 1) {
+ /* single resp. unfulfilled char (each 4th next single char)
+ * is rather bad64 error case in strict mode */
+ goto bad64;
+ }
cut += 3;
break;
}
@@ -3074,9 +3079,11 @@ BinaryDecode64(
value = (value << 6) | 0x3e;
} else if (c == '/') {
value = (value << 6) | 0x3f;
- } else if (c == '=') {
+ } else if (c == '=' && (
+ !strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */
+ ) {
value <<= 6;
- cut++;
+ if (i) cut++;
} else if (strict || !TclIsSpaceProc(c)) {
goto bad64;
} else {
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index d38fd53..4bd75c3 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1218,7 +1218,7 @@ Tcl_SplitObjCmd(
Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
for ( ; stringPtr < end; stringPtr += len) {
- int fullchar;
+ int fullchar;
len = TclUtfToUniChar(stringPtr, &ch);
fullchar = ch;
@@ -2639,9 +2639,7 @@ StringEqualCmd(
*/
objv += objc-2;
-
match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
-
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
return TCL_OK;
}
@@ -2690,7 +2688,8 @@ StringCmpCmd(
return TCL_OK;
}
-int TclStringCmpOpts(
+int
+TclStringCmpOpts(
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[], /* Argument objects. */
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index 9b9f490..faf3676 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -118,12 +118,14 @@ TclOOInitInfo(
*/
infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
- Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
- Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1),
- Tcl_NewStringObj("::oo::InfoObject", -1));
- Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1),
- Tcl_NewStringObj("::oo::InfoClass", -1));
- Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
+ if (infoCmd) {
+ Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
+ Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1),
+ Tcl_NewStringObj("::oo::InfoObject", -1));
+ Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1),
+ Tcl_NewStringObj("::oo::InfoClass", -1));
+ Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
+ }
}
/*
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 37a2ac2..5cfdb0d 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -977,10 +977,8 @@ ProcedureMethodVarResolver(
* Must not retain reference to resolved information. [Bug 3105999]
*/
- if (rPtr != NULL) {
- rPtr->deleteProc(rPtr);
- }
- return (*varPtr? TCL_OK : TCL_CONTINUE);
+ rPtr->deleteProc(rPtr);
+ return (*varPtr ? TCL_OK : TCL_CONTINUE);
}
static Tcl_Var
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 3e65791..8658e91 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -1331,6 +1331,7 @@ TclNewFSPathObj(
count = 0;
state = 1;
}
+ break;
case 1: /* Scanning for next dirsep */
switch (*p) {
case '/':
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index d1ada3a..0f2bcae 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -3274,7 +3274,8 @@ TclStringCat(
*---------------------------------------------------------------------------
*/
-int TclStringCmp(
+int
+TclStringCmp(
Tcl_Obj *value1Ptr,
Tcl_Obj *value2Ptr,
int checkEq, /* comparison is only for equality */
@@ -3292,7 +3293,6 @@ int TclStringCmp(
*/
match = 0;
} else {
-
if (!nocase && TclIsPureByteArray(value1Ptr)
&& TclIsPureByteArray(value2Ptr)) {
/*
@@ -3333,11 +3333,11 @@ int TclStringCmp(
s2 = (char *) Tcl_GetUnicode(value2Ptr);
if (
#ifdef WORDS_BIGENDIAN
- 1
+ 1
#else
- checkEq
+ checkEq
#endif
- ) {
+ ) {
memCmpFn = memcmp;
s1len *= sizeof(Tcl_UniChar);
s2len *= sizeof(Tcl_UniChar);
@@ -3347,7 +3347,8 @@ int TclStringCmp(
}
}
} else {
- if ((empty = TclCheckEmptyString(value1Ptr)) > 0) {
+ empty = TclCheckEmptyString(value1Ptr);
+ if (empty > 0) {
switch (TclCheckEmptyString(value2Ptr)) {
case -1:
s1 = 0;
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 45fd6de..38023d2 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -1490,7 +1490,7 @@ Tcl_ZlibStreamGet(
count = 0;
for (i=0; i<listLen; i++) {
Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
- itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen);
+ (void) TclGetByteArrayFromObj(itemObj, &itemLen);
if (i == 0) {
count += itemLen - zshPtr->outPos;
} else {
diff --git a/tests/binary.test b/tests/binary.test
index 54e8e94..7dc60ff 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -2720,6 +2720,46 @@ test binary-73.30 {binary decode base64} -body {
test binary-73.31 {binary decode base64} -body {
list [string length [set r [binary decode base64 WA==WFla]]] $r
} -returnCodes error -match glob -result {invalid base64 character *}
+test binary-73.32 {binary decode base64, bug [00d04c4f12]} -body {
+ list \
+ [string length [binary decode base64 =]] \
+ [string length [binary decode base64 " ="]] \
+ [string length [binary decode base64 " ="]] \
+ [string length [binary decode base64 "\r\n\t="]] \
+} -result [lrepeat 4 0]
+test binary-73.33 {binary decode base64, bug [00d04c4f12]} -body {
+ list \
+ [string length [binary decode base64 ==]] \
+ [string length [binary decode base64 " =="]] \
+ [string length [binary decode base64 " =="]] \
+ [string length [binary decode base64 " =="]] \
+} -result [lrepeat 4 0]
+test binary-73.34 {binary decode base64, (compatibility) unfulfilled base64 (single char) in non-strict mode} -body {
+ list \
+ [expr {[binary decode base64 a] eq [binary decode base64 ""]}] \
+ [expr {[binary decode base64 abcda] eq [binary decode base64 "abcd"]}]
+} -result [lrepeat 2 1]
+test binary-73.35 {binary decode base64, bad base64 in strict mode} -body {
+ set r {}
+ foreach c {a " a" " a" " a" " a" abcda abcdabcda a= a== abcda= abcda==} {
+ lappend r \
+ [catch {binary decode base64 $c}] \
+ [catch {binary decode base64 -strict $c}]
+ }
+ set r
+} -result [lrepeat 11 0 1]
+test binary-73.36 {binary decode base64: check encoded & decoded equals original} -body {
+ set r {}
+ for {set i 0} {$i < 255 && [llength $r] < 20} {incr i} {
+ foreach c {1 2 3 4 5 6 7 8} {
+ set c [string repeat [format %c $i] $c]
+ if {[set a [binary decode base64 [set x [binary encode base64 $c]]]] ne $c} {
+ lappend r "encode & decode is wrong on string `$c` (encoded: $x): `$a` != `$c`"
+ }
+ }
+ }
+ join $r \n
+} -result {}
test binary-74.1 {binary encode uuencode} -body {
binary encode uuencode
generated by cgit v0.12 at 2024-11-16 13:46:55 (GMT)