Tcl Source Code

Check-in [a0dec2ad25]
Login

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

Overview
Comment:Test and fix for botch in binary string replace.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256:a0dec2ad250b2a77490ecaef55e6805fa6021d73e29ccd1a2134c421dd403918
User & Date: dgp 2018-03-20 16:10:49
Context
2018-03-20
19:25
Merge over testing improvements from the TIP 475 work. Test files string.test and stringComp.test ha... check-in: e1141b4ed5 user: dgp tags: core-8-branch
16:10
Test and fix for botch in binary string replace. check-in: a0dec2ad25 user: dgp tags: core-8-branch
2018-03-15
20:58
Bring back makefile.vc to CRLF line-endings, as all other *.vc files check-in: 94679c0c71 user: jan.nijtmans tags: core-8-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclStringObj.c.

3633
3634
3635
3636
3637
3638
3639

3640
3641
3642
3643
3644
3645
3646
			    INT_MAX));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    result = Tcl_NewByteArrayObj(NULL, numBytes - count + newBytes);
								/* PANIC? */

	    TclAppendBytesToByteArray(result, bytes, first);	
	    TclAppendBytesToByteArray(result, iBytes, newBytes);
	    TclAppendBytesToByteArray(result, bytes + first + count,
		    numBytes - count - first);
	    return result;
	}







>







3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
			    INT_MAX));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    result = Tcl_NewByteArrayObj(NULL, numBytes - count + newBytes);
								/* PANIC? */
	    Tcl_SetByteArrayLength(result, 0);
	    TclAppendBytesToByteArray(result, bytes, first);	
	    TclAppendBytesToByteArray(result, iBytes, newBytes);
	    TclAppendBytesToByteArray(result, bytes + first + count,
		    numBytes - count - first);
	    return result;
	}

Changes to tests/string.test.

16
17
18
19
20
21
22



23
24
25
26
27
28
29
....
1392
1393
1394
1395
1396
1397
1398



1399
1400
1401
1402
1403
1404
1405
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]




# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]

# Used for constraining memory leak tests
................................................................................
} {abcdefghijklmnop}
test string-14.18 {string replace} {
    string replace abcdefghijklmnop 10 9 XXX
} {abcdefghijklmnop}
test string-14.19 {string replace} {
    string replace {} -1 0 A
} A




test string-15.1 {string tolower too few args} {
    list [catch {string tolower} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.2 {string tolower bad args} {
    list [catch {string tolower a b} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}






>
>
>







 







>
>
>







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
....
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Helper commands to test various optimizations, code paths, and special cases.
proc makeByteArray {s} {binary format a* $s}

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]

# Used for constraining memory leak tests
................................................................................
} {abcdefghijklmnop}
test string-14.18 {string replace} {
    string replace abcdefghijklmnop 10 9 XXX
} {abcdefghijklmnop}
test string-14.19 {string replace} {
    string replace {} -1 0 A
} A
test string-14.20 {string replace} {
    string replace [makeByteArray abcdefghijklmnop] end-10 end-2 [makeByteArray NEW]
} abcdeNEWop

test string-15.1 {string tolower too few args} {
    list [catch {string tolower} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.2 {string tolower bad args} {
    list [catch {string tolower a b} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}