Tcl Source Code

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

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

Overview
Comment:Make sure all uses of the [testbytestring] command are constrained.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-6-3-rc
Files: files | file ages | folders
SHA1:c60e3fa14139bbf6709d97f4989a986727a88066
User & Date: dgp 2014-11-07 13:59:27
Context
2014-11-07
14:10
update changes; more test suite polishing. check-in: 156a2211b7 user: dgp tags: core-8-6-3-rc
13:59
Make sure all uses of the [testbytestring] command are constrained. check-in: c60e3fa141 user: dgp tags: core-8-6-3-rc
2014-11-06
18:38
Merged latest trunk work (especially changes to eof handling) into the RC. check-in: b37ba326f6 user: andreask tags: core-8-6-3-rc
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/parse.test.

299
300
301
302
303
304
305
306
307


308
309
310
311
312
313
314
test parse-6.15 {ParseTokens procedure, backslash-newline} testparser {
    testparser "\"b\\\nc\"" 0
} {- \"b\\\nc\" 1 word \"b\\\nc\" 3 text b 0 backslash \\\n 0 text c 0 {}}
test parse-6.16 {ParseTokens procedure, backslash substitution} testparser {
    testparser {\n\a\x7f} 0
} {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}}
test parse-6.17 {ParseTokens procedure, null characters} {testparser testbytestring} {
    testparser [testbytestring "foo\0zz"] 0
} "- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}"


test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} testparser {
    # Test for Bug 681841
    list [catch {testparser {[a]} 2} msg] $msg
} {1 {missing close-bracket}}

test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} testparser {
    testparser {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 0







|
|
>
>







299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
test parse-6.15 {ParseTokens procedure, backslash-newline} testparser {
    testparser "\"b\\\nc\"" 0
} {- \"b\\\nc\" 1 word \"b\\\nc\" 3 text b 0 backslash \\\n 0 text c 0 {}}
test parse-6.16 {ParseTokens procedure, backslash substitution} testparser {
    testparser {\n\a\x7f} 0
} {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}}
test parse-6.17 {ParseTokens procedure, null characters} {testparser testbytestring} {
    expr {[testparser [testbytestring "foo\0zz"] 0] eq
"- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}"
	}
} 1
test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} testparser {
    # Test for Bug 681841
    list [catch {testparser {[a]} 2} msg] $msg
} {1 {missing close-bracket}}

test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} testparser {
    testparser {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 0

Changes to tests/parseOld.test.

259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
test parseOld-7.10 {backslash substitution} {
    eval "list a b\\\nc d"
} {a b c d}
test parseOld-7.11 {backslash substitution} {
    eval "list a \"b c\"\\\nd e"
} {a {b c} d e}
test parseOld-7.12 {backslash substitution} testbytestring {
    list \ua2
} [testbytestring "\xc2\xa2"]
test parseOld-7.13 {backslash substitution} testbytestring {
    list \u4e21
} [testbytestring "\xe4\xb8\xa1"]
test parseOld-7.14 {backslash substitution} testbytestring {
    list \u4e2k
} [testbytestring "\xd3\xa2k"]

# Semi-colon.

test parseOld-8.1 {semi-colons} {
    set b 0
    getArgs a;set b 2
    set argv







|
|
|
|
|
|
|
|







259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
test parseOld-7.10 {backslash substitution} {
    eval "list a b\\\nc d"
} {a b c d}
test parseOld-7.11 {backslash substitution} {
    eval "list a \"b c\"\\\nd e"
} {a {b c} d e}
test parseOld-7.12 {backslash substitution} testbytestring {
    expr {[list \ua2] eq [testbytestring "\xc2\xa2"]}
} 1
test parseOld-7.13 {backslash substitution} testbytestring {
    expr {[list \u4e21] eq [testbytestring "\xe4\xb8\xa1"]}
} 1
test parseOld-7.14 {backslash substitution} testbytestring {
    expr {[list \u4e2k] eq [testbytestring "\xd3\xa2k"]}
} 1

# Semi-colon.

test parseOld-8.1 {semi-colons} {
    set b 0
    getArgs a;set b 2
    set argv

Changes to tests/subst.test.

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
    subst a
} a
test subst-2.3 {simple strings} {
    subst abcdefg
} abcdefg
test subst-2.4 {simple strings} testbytestring {
    # Tcl Bug 685106
    subst [testbytestring bar\x00soom]
} [testbytestring bar\x00soom]

test subst-3.1 {backslash substitutions} {
    subst {\x\$x\[foo bar]\\}
} "x\$x\[foo bar]\\"
test subst-3.2 {backslash substitutions with utf chars} {
    # 'j' is just a char that doesn't mean anything, and \344 is 'ä'
    # that also doesn't mean anything, but is multi-byte in UTF-8.







|
|







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
    subst a
} a
test subst-2.3 {simple strings} {
    subst abcdefg
} abcdefg
test subst-2.4 {simple strings} testbytestring {
    # Tcl Bug 685106
    expr {[subst [testbytestring bar\x00soom]] eq [testbytestring bar\x00soom]}
} 1

test subst-3.1 {backslash substitutions} {
    subst {\x\$x\[foo bar]\\}
} "x\$x\[foo bar]\\"
test subst-3.2 {backslash substitutions with utf chars} {
    # 'j' is just a char that doesn't mean anything, and \344 is 'ä'
    # that also doesn't mean anything, but is multi-byte in UTF-8.

Changes to tests/utf.test.

17
18
19
20
21
22
23
24
25

26
27
28

29
30
31

32
33
34

35
36
37

38
39
40

41
42
43
44
45
46
47
...
124
125
126
127
128
129
130
131
132

133
134
135

136
137
138

139
140
141

142
143
144
145
146
147
148
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testbytestring [llength [info commands testbytestring]]

catch {unset x}

test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring {
    set x \x01
} [testbytestring "\x01"]

test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
    set x "\x00"
} [testbytestring "\xc0\x80"]

test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
    set x "\xe0"
} [testbytestring "\xc3\xa0"]

test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring {
    set x "\u4e4e"
} [testbytestring "\xe4\xb9\x8e"]

test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring {
    format %c 0x110000
} [testbytestring "\xef\xbf\xbd"]

test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {
    format %c -1
} [testbytestring "\xef\xbf\xbd"]


test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
    string length "abc"
} {3}
test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} testbytestring {
    string length [testbytestring "\x82\x83\x84"]
} {3}
................................................................................


test utf-10.1 {Tcl_UtfBackslash: dst == NULL} {
    set x \n
} {
}
test utf-10.2 {Tcl_UtfBackslash: \u subst} testbytestring {
    set x \ua2
} [testbytestring "\xc2\xa2"]

test utf-10.3 {Tcl_UtfBackslash: longer \u subst} testbytestring {
    set x \u4e21
} [testbytestring "\xe4\xb8\xa1"]

test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring {
    set x \u4e2k
} "[testbytestring \xd3\xa2]k"

test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring {
    set x \u4e216
} "[testbytestring \xe4\xb8\xa1]6"

proc bsCheck {char num} {
    global errNum
    test utf-10.$errNum {backslash substitution} {
	scan $char %c value
	set value
    } $num
    incr errNum







<
|
>

<
|
>

<
|
>

<
|
>

<
|
>

<
|
>







 







<
|
>

<
|
>

<
|
>

<
|
>







17
18
19
20
21
22
23

24
25
26

27
28
29

30
31
32

33
34
35

36
37
38

39
40
41
42
43
44
45
46
47
...
124
125
126
127
128
129
130

131
132
133

134
135
136

137
138
139

140
141
142
143
144
145
146
147
148
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testbytestring [llength [info commands testbytestring]]

catch {unset x}

test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring {

    expr {"\x01" eq [testbytestring "\x01"]}
} 1
test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {

    expr {"\x00" eq [testbytestring "\xc0\x80"]}
} 1
test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {

    expr {"\xe0" eq [testbytestring "\xc3\xa0"]}
} 1
test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring {

    expr {"\u4e4e" eq [testbytestring "\xe4\xb9\x8e"]}
} 1
test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring {

    expr {[format %c 0x110000] eq [testbytestring "\xef\xbf\xbd"]}
} 1
test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {

    expr {[format %c -1] eq [testbytestring "\xef\xbf\xbd"]}
} 1

test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
    string length "abc"
} {3}
test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} testbytestring {
    string length [testbytestring "\x82\x83\x84"]
} {3}
................................................................................


test utf-10.1 {Tcl_UtfBackslash: dst == NULL} {
    set x \n
} {
}
test utf-10.2 {Tcl_UtfBackslash: \u subst} testbytestring {

    expr {"\ua2" eq [testbytestring "\xc2\xa2"]}
} 1
test utf-10.3 {Tcl_UtfBackslash: longer \u subst} testbytestring {

    expr {"\u4e21" eq [testbytestring "\xe4\xb8\xa1"]}
} 1
test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring {

    expr {"\u4e2k" eq "[testbytestring \xd3\xa2]k"}
} 1
test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring {

    expr {"\u4e216" eq "[testbytestring \xe4\xb8\xa1]6"}
} 1
proc bsCheck {char num} {
    global errNum
    test utf-10.$errNum {backslash substitution} {
	scan $char %c value
	set value
    } $num
    incr errNum