Tcl Source Code

Check-in [770e6649a4]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:[00d04c4f12] Repair broken edge cases in [binary encode base64].
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | release | core-8-6-9-rc | core-8-6-9
Files: files | file ages | folders
SHA3-256: 770e6649a47ac43aabb2530a01b6129700889528c98f96debd99910f4ff11265
User & Date: dgp 2018-11-16 18:45:59
Context
2018-11-16
20:26
merge release check-in: 7aa0a364d5 user: dgp tags: core-8-6-branch
18:45
[00d04c4f12] Repair broken edge cases in [binary encode base64]. Closed-Leaf check-in: 770e6649a4 user: dgp tags: release, core-8-6-9-rc, core-8-6-9
18:38
[00d04c4f12] Repair broken edge cases in [binary encode base64]. check-in: 4b91471ac4 user: dgp tags: core-8-6-branch
2018-11-09
19:14
update changes check-in: 27603fe3a8 user: dgp tags: core-8-6-9-rc, rc4
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to changes.

8886
8887
8888
8889
8890
8891
8892
8893


8894
2018-10-27 tzdata updated to Olson's tzdata2018g (jima)

2018-10-29 Update tcltest package for Travis support (fellows)
=> tcltest 2.5.0

2018-11-09 (bug)[35a8f1] overlong string length of some lists (owens)



- Released 8.6.9, November 16, 2018 - details at http://core.tcl-lang.org/tcl/ -







>
>

8886
8887
8888
8889
8890
8891
8892
8893
8894
8895
8896
2018-10-27 tzdata updated to Olson's tzdata2018g (jima)

2018-10-29 Update tcltest package for Travis support (fellows)
=> tcltest 2.5.0

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 generic/tclBinary.c.

2910
2911
2912
2913
2914
2915
2916





2917
2918
2919
2920
2921
2922
2923
....
2940
2941
2942
2943
2944
2945
2946
2947


2948
2949
2950
2951
2952
2953
2954
2955
2956
	     */

	    if (data < dataend) {
		c = *data++;
	    } else if (i > 1) {
		c = '=';
	    } else {





		cut += 3;
		break;
	    }

	    /*
	     * Load the character into the block value. Handle ='s specially
	     * because they're only valid as the last character or two of the
................................................................................
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=') {


		value <<= 6;
		cut++;
	    } else if (strict || !isspace(c)) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);






>
>
>
>
>







 







|
>
>

|







2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
....
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
	     */

	    if (data < dataend) {
		c = *data++;
	    } 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;
	    }

	    /*
	     * Load the character into the block value. Handle ='s specially
	     * because they're only valid as the last character or two of the
................................................................................
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=' && (
		!strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */
	    ) {
		value <<= 6;
		if (i) cut++;
	    } else if (strict || !isspace(c)) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);

Changes to tests/binary.test.

2707
2708
2709
2710
2711
2712
2713








































2714
2715
2716
2717
2718
2719
2720
} -returnCodes error -match glob -result {invalid base64 character *}
test binary-73.30 {binary decode base64} -body {
    list [string length [set r [binary decode base64 -strict WFla\n]]] $r
} -returnCodes error -match glob -result {invalid base64 character *}
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-74.1 {binary encode uuencode} -body {
    binary encode uuencode
} -returnCodes error -match glob -result "wrong # args: *"
test binary-74.2 {binary encode uuencode} -body {
    binary encode uuencode abc
} -result {#86)C






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
} -returnCodes error -match glob -result {invalid base64 character *}
test binary-73.30 {binary decode base64} -body {
    list [string length [set r [binary decode base64 -strict WFla\n]]] $r
} -returnCodes error -match glob -result {invalid base64 character *}
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
} -returnCodes error -match glob -result "wrong # args: *"
test binary-74.2 {binary encode uuencode} -body {
    binary encode uuencode abc
} -result {#86)C