Tcl Source Code

Check-in [a0d51b9a0e]
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:merge core-8-6-branch
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256:a0d51b9a0ee2179c8c74868615abfa1371dbdfc9244d94e12c2f385389d8861a
User & Date: jan.nijtmans 2018-01-11 15:45:20
Context
2018-01-17
10:07
merge core-8-6-branch (typo's) check-in: f939eeb6ed user: jan.nijtmans tags: core-8-branch
2018-01-16
08:40
merge core-8-branch check-in: 806c23cf3f user: jan.nijtmans tags: no-wideint
2018-01-15
11:41
merge core-8-branch check-in: 962da37427 user: jan.nijtmans tags: z_modifier
2018-01-12
16:30
merge core-8-branch Closed-Leaf check-in: cb3d9b77de user: jan.nijtmans tags: tip-485
11:18
merge core-8-branch check-in: 3451858e13 user: jan.nijtmans tags: trunk
2018-01-11
15:59
merge core-8-branch. Remove left-over debugging code. Test-case string-5.21 still fails. check-in: ad24e66451 user: jan.nijtmans tags: tip-389
15:45
merge core-8-6-branch check-in: a0d51b9a0e user: jan.nijtmans tags: core-8-branch
15:44
Fix behavior of Tcl_GetRange() and "string range" regarding surrogates, when Tcl is compiled with -D... check-in: 27a52735df user: jan.nijtmans tags: core-8-6-branch
2018-01-10
14:02
Re-implement Tcl_WinTCharToUtf/Tcl_WinUtfToTChar in pure win32 api, even for TCL_UTF_MAX=3. We can d... check-in: a2c5eee57d user: jan.nijtmans tags: core-8-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclStringObj.c.

518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
...
652
653
654
655
656
657
658











659
660
661
662
663
664
665
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicode --
 *
 *	Get the Unicode form of the String object. If the object is not
 *	already a String object, it will be converted to one. If the String
 *	object does not have a Unicode rep, then one is create from the UTF
 *	string format.
 *
 * Results:
 *	Returns a pointer to the object's internal Unicode string.
 *
 * Side effects:
 *	Converts the object to have the String internal rep.
................................................................................
	    stringPtr->numChars = newObjPtr->length;
	    return newObjPtr;
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }












    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetStringObj --







|







 







>
>
>
>
>
>
>
>
>
>
>







518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
...
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicode --
 *
 *	Get the Unicode form of the String object. If the object is not
 *	already a String object, it will be converted to one. If the String
 *	object does not have a Unicode rep, then one is created from the UTF
 *	string format.
 *
 * Results:
 *	Returns a pointer to the object's internal Unicode string.
 *
 * Side effects:
 *	Converts the object to have the String internal rep.
................................................................................
	    stringPtr->numChars = newObjPtr->length;
	    return newObjPtr;
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }

#if TCL_UTF_MAX == 4
	/* See: bug [11ae2be95dac9417] */
	if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00)
		&& ((stringPtr->unicode[first-1]&0xFC00) == 0xD800)) {
	    ++first;
	}
	if ((last+1<stringPtr->numChars) && ((stringPtr->unicode[last+1]&0xFC00) == 0xDC00)
		&& ((stringPtr->unicode[last]&0xFC00) == 0xD800)) {
	    ++last;
	}
#endif
    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetStringObj --

Changes to tests/string.test.

20
21
22
23
24
25
26

27
28
29
30
31
32
33
....
1284
1285
1286
1287
1288
1289
1290



1291
1292
1293
1294
1295
1296
1297
::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] != {}}]


# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]

proc representationpoke s {
    set r [::tcl::unsupported::representation $s]
    list [lindex $r 3] [string match {*, string representation "*"} $r]
................................................................................
    list $input_hex $rxBuffer_hex $rxCRC_hex
} {000341 000341 0341}
test string-12.22 {string range, shimmering binary/index} {
    set s 0000000001
    binary scan $s a* x
    string range $s $s end
} 000000001




test string-13.1 {string repeat} {
    list [catch {string repeat} msg] $msg
} {1 {wrong # args: should be "string repeat string count"}}
test string-13.2 {string repeat} {
    list [catch {string repeat abc 10 oops} msg] $msg
} {1 {wrong # args: should be "string repeat string count"}}







>







 







>
>
>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
....
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
::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
testConstraint memory [llength [info commands memory]]

proc representationpoke s {
    set r [::tcl::unsupported::representation $s]
    list [lindex $r 3] [string match {*, string representation "*"} $r]
................................................................................
    list $input_hex $rxBuffer_hex $rxCRC_hex
} {000341 000341 0341}
test string-12.22 {string range, shimmering binary/index} {
    set s 0000000001
    binary scan $s a* x
    string range $s $s end
} 000000001
test string-12.23 {string range, surrogates, bug [11ae2be95dac9417]} fullutf {
    list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]
} [list \U100000 {} b]

test string-13.1 {string repeat} {
    list [catch {string repeat} msg] $msg
} {1 {wrong # args: should be "string repeat string count"}}
test string-13.2 {string repeat} {
    list [catch {string repeat abc 10 oops} msg] $msg
} {1 {wrong # args: should be "string repeat string count"}}