Tcl Source Code

Check-in [d50c1e61f1]
Login

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

Overview
Comment:Merge new test and comments from 8.5 to demo that INST_STR_REPLACE is bad.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256: d50c1e61f1254c083c2289cdf02bbf7473396c551a38805c520981f42a51e3e4
User & Date: dgp 2018-03-13 03:26:42.778
Context
2018-03-13
04:01
Repair the INST_STR_REPLACE instruction. check-in: 3101f3fd20 user: dgp tags: core-8-6-branch
03:26
Merge new test and comments from 8.5 to demo that INST_STR_REPLACE is bad. check-in: d50c1e61f1 user: dgp tags: core-8-6-branch
03:15
Tidy up and comment [string replace] and its corner cases. check-in: dfe3934edb user: dgp tags: core-8-5-branch
2018-03-12
02:48
It is confusingly stupid to use variable "length" to hold an actual length in part of a routine, and... check-in: 4d996dc6aa user: dgp tags: core-8-6-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tclCmdMZ.c.
2348
2349
2350
2351
2352
2353
2354

2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373


2374
2375
2376
2377
2378






2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
static int
StringRplcCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    int first, last, length, end;

    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
	return TCL_ERROR;
    }

    (void) Tcl_GetUnicodeFromObj(objv[1], &length);
    end = length - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK){
	return TCL_ERROR;
    }

    /*
     * [string replace] does not replace empty strings.  This is
     * unwise, but since it is true, here we quickly screen out
     * index pairs that demarcate an empty substring.


     */

    if ((last < 0) ||		/* Range ends before start of string */
	    (first > end) ||	/* Range begins after end of string */
	    (last < first)) {	/* Range begins after it starts */






	Tcl_SetObjResult(interp, objv[1]);
    } else {
	Tcl_Obj *resultPtr;

	/*
	 * We are re-fetching in case the string argument is same value as 
	 * an index argument, and shimmering cost us our ustring.
	 */

	Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objv[1], &length);

	end = length - 1;

	if (first < 0) {
	    first = 0;
	}

	resultPtr = Tcl_NewUnicodeObj(ustring, first);
	if (objc == 5) {







>







|








<
<
|
>
>

<



>
>
>
>
>
>









|
<
|







2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371


2372
2373
2374
2375

2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394

2395
2396
2397
2398
2399
2400
2401
2402
static int
StringRplcCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *ustring;
    int first, last, length, end;

    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
	return TCL_ERROR;
    }

    ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
    end = length - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK){
	return TCL_ERROR;
    }

    /*


     * The following test screens out most empty substrings as
     * candidates for replacement. When they are detected, no
     * replacement is done, and the result is the original string,
     */

    if ((last < 0) ||		/* Range ends before start of string */
	    (first > end) ||	/* Range begins after end of string */
	    (last < first)) {	/* Range begins after it starts */

	/*
	 * BUT!!! when (end < 0) -- an empty original string -- we can
	 * have (first <= end < 0 <= last) and an empty string is permitted
	 * to be replaced.
	 */
	Tcl_SetObjResult(interp, objv[1]);
    } else {
	Tcl_Obj *resultPtr;

	/*
	 * We are re-fetching in case the string argument is same value as 
	 * an index argument, and shimmering cost us our ustring.
	 */

	ustring = Tcl_GetUnicodeFromObj(objv[1], &length);

	end = length-1;

	if (first < 0) {
	    first = 0;
	}

	resultPtr = Tcl_NewUnicodeObj(ustring, first);
	if (objc == 5) {
Changes to generic/tclCompCmdsSZ.c.
1004
1005
1006
1007
1008
1009
1010

1011
1012
1013
1014
1015
1016
1017
    }
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (parsePtr->numWords == 5) {
	tokenPtr = TokenAfter(valueTokenPtr);
	tokenPtr = TokenAfter(tokenPtr);
	replacementTokenPtr = TokenAfter(tokenPtr);
    }


    tokenPtr = TokenAfter(valueTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
	    &idx1) != TCL_OK) {
	goto genericReplace;
    }
    /*







>







1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
    }
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (parsePtr->numWords == 5) {
	tokenPtr = TokenAfter(valueTokenPtr);
	tokenPtr = TokenAfter(tokenPtr);
	replacementTokenPtr = TokenAfter(tokenPtr);
    }
	goto genericReplace;

    tokenPtr = TokenAfter(valueTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
	    &idx1) != TCL_OK) {
	goto genericReplace;
    }
    /*
Changes to tests/string.test.
1374
1375
1376
1377
1378
1379
1380






1381
1382
1383
1384
1385
1386
1387
} {abcdeNEWop}
test string-14.16 {string replace} {
    string replace abcdefghijklmnop 0 end foo
} {foo}
test string-14.17 {string replace} {
    string replace abcdefghijklmnop end end-1
} {abcdefghijklmnop}







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?}}







>
>
>
>
>
>







1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
} {abcdeNEWop}
test string-14.16 {string replace} {
    string replace abcdefghijklmnop 0 end foo
} {foo}
test string-14.17 {string replace} {
    string replace abcdefghijklmnop end end-1
} {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?}}