Tcl Source Code

Check-in [93dd8bb33b]
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:Fixed the weird edge case.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-3613609
Files: files | file ages | folders
SHA1: 93dd8bb33b1ac77a85c94deac4ef874105ed1334
User & Date: dkf 2013-05-22 12:55:50
Context
2013-05-22
12:59
[3613609]: Replace strcasecmp() with UTF-8-aware version. check-in: 8cc7cdfbd6 user: dkf tags: core-8-5-branch
12:55
Fixed the weird edge case. Closed-Leaf check-in: 93dd8bb33b user: dkf tags: bug-3613609
12:32
Improved tests. check-in: 1fbbe4aec3 user: dkf tags: bug-3613609
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclUtf.c.

1097
1098
1099
1100
1101
1102
1103
1104


1105



1106











1107
1108
1109
1110
1111

1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125

1126
1127
1128



1129
1130
1131
1132
1133
1134
1135
	    if (ch1 != ch2) {
		return (ch1 - ch2);
	    }
	}
    }
    return 0;
}







/* Replacement for strcasecmp in Tcl core, in places where UTF-8 should be handled. */











int
TclUtfCasecmp(
    CONST char *cs,		/* UTF string to compare to ct. */
    CONST char *ct)		/* UTF string cs is compared to. */
{

    Tcl_UniChar ch1, ch2;
    int goOn;

    do {

	/* If *cs == '\0' or *ct == '\0', loop should end. */
	goOn = *cs && *ct;

	cs += TclUtfToUniChar(cs, &ch1);
	ct += TclUtfToUniChar(ct, &ch2);
	if (ch1 != ch2) {
	    ch1 = Tcl_UniCharToLower(ch1);
	    ch2 = Tcl_UniCharToLower(ch2);
	    if (ch1 != ch2) break;

	}
    } while (goOn);
    return (ch1 - ch2);



}

 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharToUpper --






|
>
>
|
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>





>
|
<
<
<
<
<
<






|
>
|
<
<
>
>
>







1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129






1130
1131
1132
1133
1134
1135
1136
1137
1138


1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
	    if (ch1 != ch2) {
		return (ch1 - ch2);
	    }
	}
    }
    return 0;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UtfNcasecmp --
 *
 *	Compare UTF chars of string cs to string ct case insensitively.
 *	Replacement for strcasecmp in Tcl core, in places where UTF-8 should
 *	be handled.
 *
 * Results:
 *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUtfCasecmp(
    CONST char *cs,		/* UTF string to compare to ct. */
    CONST char *ct)		/* UTF string cs is compared to. */
{
    while (*cs && *ct) {
	Tcl_UniChar ch1, ch2;







	cs += TclUtfToUniChar(cs, &ch1);
	ct += TclUtfToUniChar(ct, &ch2);
	if (ch1 != ch2) {
	    ch1 = Tcl_UniCharToLower(ch1);
	    ch2 = Tcl_UniCharToLower(ch2);
	    if (ch1 != ch2) {
		return ch1 - ch2;
	    }


	}
    }
    return UCHAR(*cs) - UCHAR(*ct);
}

 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharToUpper --

Changes to tests/cmdIL.test.

395
396
397
398
399
400
401



402
403
404
405
406
407
408
    lsort -ascii -nocase {d E c B a D35 d300 100 20}
} {100 20 a B c d d300 D35 E}
test cmdIL-4.36 {SortCompare procedure, UTF-8 with -nocase option} {
    scan [lsort -ascii -nocase [list \u101 \u100]] %c%c%c
} {257 32 256}
test cmdIL-4.37 {SortCompare procedure, UTF-8 with -nocase option} {
    scan [lsort -ascii -nocase [list a\u0000a a]] %c%c%c%c%c



} {97 32 97 0 97}

test cmdIL-5.1 {lsort with list style index} {
    lsort -ascii -decreasing -index {0 1} {
	{{Jim Alpha} 20000410}
	{{Joe Bravo} 19990320}
	{{Jacky Charlie} 19390911}






>
>
>







395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
    lsort -ascii -nocase {d E c B a D35 d300 100 20}
} {100 20 a B c d d300 D35 E}
test cmdIL-4.36 {SortCompare procedure, UTF-8 with -nocase option} {
    scan [lsort -ascii -nocase [list \u101 \u100]] %c%c%c
} {257 32 256}
test cmdIL-4.37 {SortCompare procedure, UTF-8 with -nocase option} {
    scan [lsort -ascii -nocase [list a\u0000a a]] %c%c%c%c%c
} {97 32 97 0 97}
test cmdIL-4.38 {SortCompare procedure, UTF-8 with -nocase option} {
    scan [lsort -ascii -nocase [list a a\u0000a]] %c%c%c%c%c
} {97 32 97 0 97}

test cmdIL-5.1 {lsort with list style index} {
    lsort -ascii -decreasing -index {0 1} {
	{{Jim Alpha} 20000410}
	{{Joe Bravo} 19990320}
	{{Jacky Charlie} 19390911}