Tcl Source Code

Check-in [8d4c5a08c5]
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:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | novem
Files: files | file ages | folders
SHA1: 8d4c5a08c5210d7a4b6f4beda04d1ab0ded62fa1
User & Date: jan.nijtmans 2016-11-10 15:13:22
Context
2016-11-11
15:18
merge trunk check-in: 6ca5f2d8bf user: jan.nijtmans tags: novem
2016-11-10
15:13
merge trunk check-in: 8d4c5a08c5 user: jan.nijtmans tags: novem
14:21
On OSX, there is a conflict with the "define panic" and definitions in "mach.h". check-in: e1804c00ba user: jan.nijtmans tags: trunk
2016-11-04
11:53
merge trunk check-in: 00e57db1bf user: jan.nijtmans tags: novem
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCmdMZ.c.

1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203

1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228



1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263

1264
1265
1266
1267
1268
1269
1270
....
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316

1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335


1336
1337
1338


1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361

1362
1363
1364
1365
1366
1367
1368
static int
StringFirstCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *needleStr, *haystackStr;
    int match, start, needleLen, haystackLen;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    /*
     * We are searching haystackStr for the sequence needleStr.
     */

    match = -1;
    start = 0;
    haystackLen = -1;

    needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
    haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);

    if (objc == 4) {
	/*
	 * If a startIndex is specified, we will need to fast forward to that
	 * point in the string before we think about a match.
	 */


	if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
		&start) != TCL_OK){
	    return TCL_ERROR;
	}

	/*
	 * Reread to prevent shimmering problems.
	 */

	needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
	haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);

	if (start >= haystackLen) {
	    goto str_first_done;
	} else if (start > 0) {
	    haystackStr += start;
	    haystackLen -= start;
	} else if (start < 0) {
	    /*
	     * Invalid start index mapped to string start; Bug #423581
	     */

	    start = 0;
	}



    }

    /*
     * If the length of the needle is more than the length of the haystack, it
     * cannot be contained in there so we can avoid searching. [Bug 2960021]
     */

    if (needleLen > 0 && needleLen <= haystackLen) {
	register Tcl_UniChar *p, *end;

	end = haystackStr + haystackLen - needleLen + 1;
	for (p = haystackStr;  p < end;  p++) {
	    /*
	     * Scan forward to find the first character.
	     */

	    if ((*p == *needleStr) && (memcmp(needleStr, p,
		    sizeof(Tcl_UniChar) * (size_t)needleLen) == 0)) {
		match = p - haystackStr;
		break;
	    }
	}
    }

    /*
     * Compute the character index of the matching string by counting the
     * number of characters before the match.
     */

    if ((match != -1) && (objc == 4)) {
	match += start;
    }

  str_first_done:
    Tcl_SetObjResult(interp, Tcl_NewLongObj(match));

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringLastCmd --
................................................................................
static int
StringLastCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *needleStr, *haystackStr, *p;
    int match, start, needleLen, haystackLen;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    /*
     * We are searching haystackString for the sequence needleString.
     */

    match = -1;
    start = 0;
    haystackLen = -1;

    needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
    haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);

    if (objc == 4) {
	/*
	 * If a startIndex is specified, we will need to restrict the string
	 * range to that char index in the string
	 */


	if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
		&start) != TCL_OK){
	    return TCL_ERROR;
	}

	/*
	 * Reread to prevent shimmering problems.
	 */

	needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
	haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);

	if (start < 0) {
	    goto str_last_done;
	} else if (start < haystackLen) {
	    p = haystackStr + start + 1 - needleLen;
	} else {
	    p = haystackStr + haystackLen - needleLen;


	}
    } else {
	p = haystackStr + haystackLen - needleLen;


    }

    /*
     * If the length of the needle is more than the length of the haystack, it
     * cannot be contained in there so we can avoid searching. [Bug 2960021]
     */

    if (needleLen > 0 && needleLen <= haystackLen) {
	for (; p >= haystackStr; p--) {
	    /*
	     * Scan backwards to find the first character.
	     */

	    if ((*p == *needleStr) && !memcmp(needleStr, p,
		    sizeof(Tcl_UniChar) * (size_t)needleLen)) {
		match = p - haystackStr;
		break;
	    }
	}
    }

  str_last_done:
    Tcl_SetObjResult(interp, Tcl_NewLongObj(match));

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringIndexCmd --






|
<







<
<
<
<
<
<
<
<
<
<
<

<
<
<
<
>

|
<



<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<


>
>
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
>







 







|
<



|



<
<
<
<
<
<
<
<
<
<
<

<
<
<
<
>

|
<



<
<
<
<
<
<
<
|
<
<
<
<
<
>
>

<
<
>
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
>







1172
1173
1174
1175
1176
1177
1178
1179

1180
1181
1182
1183
1184
1185
1186











1187




1188
1189
1190

1191
1192
1193












1194




1195
1196
1197
1198
1199
1200
1201
































1202
1203
1204
1205
1206
1207
1208
1209
1210
....
1225
1226
1227
1228
1229
1230
1231
1232

1233
1234
1235
1236
1237
1238
1239











1240




1241
1242
1243

1244
1245
1246







1247





1248
1249
1250


1251
1252
1253
1254




















1255
1256
1257
1258
1259
1260
1261
1262
1263
static int
StringFirstCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int start = 0;


    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }












    if (objc == 4) {




	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {

	    return TCL_ERROR;
	}













	if (start < 0) {




	    start = 0;
	}
	if (start >= size) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	    return TCL_OK;
	}
    }
































    Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFind(objv[1],
	    objv[2], start)));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringLastCmd --
................................................................................
static int
StringLastCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int last = INT_MAX - 1;


    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?lastIndex?");
	return TCL_ERROR;
    }












    if (objc == 4) {




	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {

	    return TCL_ERROR;
	}








	if (last < 0) {





	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	    return TCL_OK;
	}


	if (last >= size) {
	    last = size - 1;
	}
    }




















    Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringLast(objv[1],
	    objv[2], last)));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringIndexCmd --

Changes to generic/tclEnsemble.c.

3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
	    }
	}
	/*
	 * The length of the "replaced" list must be depth-1.  Trim back
	 * any extra elements that might have been appended by failing
	 * pathways above.
	 */
	(void) Tcl_ListObjReplace(NULL, replaced, depth-1, INT_MAX, 0, NULL);

	/*
	 * TODO: Reconsider whether we ought to call CompileToInvokedCommand()
	 * when depth==1.  In that case we are choosing to emit the
	 * INST_INVOKE_REPLACE bytecode when there is in fact no replacing
	 * to be done.  It would be equally functional and presumably more
	 * performant to fall through to cleanup below, return TCL_ERROR,






|







3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
	    }
	}
	/*
	 * The length of the "replaced" list must be depth-1.  Trim back
	 * any extra elements that might have been appended by failing
	 * pathways above.
	 */
	(void) Tcl_ListObjReplace(NULL, replaced, depth-1, LIST_MAX, 0, NULL);

	/*
	 * TODO: Reconsider whether we ought to call CompileToInvokedCommand()
	 * when depth==1.  In that case we are choosing to emit the
	 * INST_INVOKE_REPLACE bytecode when there is in fact no replacing
	 * to be done.  It would be equally functional and presumably more
	 * performant to fall through to cleanup below, return TCL_ERROR,

Changes to generic/tclExecute.c.

5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
	}
    doneStringMap:
	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:
	ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length);	/* Haystack */
	ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */

	match = -1;
	if (length2 > 0 && length2 <= length) {
	    end = ustring1 + length - length2 + 1;
	    for (p=ustring1 ; p<end ; p++) {
		if ((*p == *ustring2) &&
			memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
		    match = p - ustring1;
		    break;
		}
	    }
	}

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
	TclNewLongObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length);	/* Haystack */
	ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */

	match = -1;
	if (length2 > 0 && length2 <= length) {
	    for (p=ustring1+length-length2 ; p>=ustring1 ; p--) {
		if ((*p == *ustring2) &&
			memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
		    match = p - ustring1;
		    break;
		}
	    }
	}

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));

	TclNewLongObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
	opnd = TclGetInt1AtPtr(pc+1);
	valuePtr = OBJ_AT_TOS;
	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,






|
<
<
<
<
<
<
<
<
<
<
<
<
<







|
<
<
<
<
<
<
<
<
<
<
<
<



<







5584
5585
5586
5587
5588
5589
5590
5591













5592
5593
5594
5595
5596
5597
5598
5599












5600
5601
5602

5603
5604
5605
5606
5607
5608
5609
	}
    doneStringMap:
	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:
	match = TclStringFind(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);














	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
	TclNewLongObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	match = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);













	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));

	TclNewLongObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
	opnd = TclGetInt1AtPtr(pc+1);
	valuePtr = OBJ_AT_TOS;
	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,

Changes to generic/tclInt.h.

3074
3075
3076
3077
3078
3079
3080




3081
3082
3083
3084
3085
3086
3087
			    Tcl_Obj *const *objv, int objc, int subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);
MODULE_SCOPE int	TclStringCatObjv(Tcl_Interp *interp, int inPlace,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Obj **objPtrPtr);




MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,






>
>
>
>







3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
			    Tcl_Obj *const *objv, int objc, int subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);
MODULE_SCOPE int	TclStringCatObjv(Tcl_Interp *interp, int inPlace,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Obj **objPtrPtr);
MODULE_SCOPE int	TclStringFind(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int start);
MODULE_SCOPE int	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int last);
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,

Changes to generic/tclListObj.c.

893
894
895
896
897
898
899

900
901
902
903
904
905
906
907
908
909

910
911


912
913
914
915
916
917
918
	first = 0;
    }
    if (first >= numElems) {
	first = numElems;	/* So we'll insert after last element. */
    }
    if (count < 0) {
	count = 0;

    } else if (numElems < first+count || first+count < 0) {
	/*
	 * The 'first+count < 0' condition here guards agains integer
	 * overflow in determining 'first+count'.
	 */

	count = numElems - first;
    }

    if (objc > LIST_MAX - (numElems - count)) {

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"max length of a Tcl list (%d elements) exceeded", LIST_MAX));


	return TCL_ERROR;
    }
    isShared = (listRepPtr->refCount > 1);
    numRequired = numElems - count + objc; /* Known <= LIST_MAX */
    needGrow = numRequired > listRepPtr->maxElemCount;

    for (i = 0;  i < objc;  i++) {






>
|
<
<
<
<





>
|
|
>
>







893
894
895
896
897
898
899
900
901




902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
	first = 0;
    }
    if (first >= numElems) {
	first = numElems;	/* So we'll insert after last element. */
    }
    if (count < 0) {
	count = 0;
    } else if (first > INT_MAX - count /* Handle integer overflow */
	    || numElems < first+count) {





	count = numElems - first;
    }

    if (objc > LIST_MAX - (numElems - count)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX));
	}
	return TCL_ERROR;
    }
    isShared = (listRepPtr->refCount > 1);
    numRequired = numElems - count + objc; /* Known <= LIST_MAX */
    needGrow = numRequired > listRepPtr->maxElemCount;

    for (i = 0;  i < objc;  i++) {

Changes to generic/tclStringObj.c.

2834
2835
2836
2837
2838
2839
2840









































































































































































































2841
2842
2843
2844
2845
2846
2847
		dst += more;
	    }
	}
    }
    *objPtrPtr = objResultPtr;
    return TCL_OK;
}









































































































































































































 
/*
 *---------------------------------------------------------------------------
 *
 * TclStringObjReverse --
 *
 *	Implements the [string reverse] operation.






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
		dst += more;
	    }
	}
    }
    *objPtrPtr = objResultPtr;
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclStringFind --
 *
 *	Implements the [string first] operation.
 *
 * Results:
 *	If needle is found as a substring of haystack, the index of the
 *	first instance of such a find is returned.  If needle is not present
 *	as a substring of haystack, -1 is returned.
 *
 * Side effects:
 *	needle and haystack may have their Tcl_ObjType changed.
 *
 *---------------------------------------------------------------------------
 */

int
TclStringFind(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    int start)
{
    int lh, ln = Tcl_GetCharLength(needle);

    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!
	 *
	 * 	TODO: When we one day make this a true substring
	 * 	finder, change this to "return 0"
	 */
	return -1;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *end, *try, *bh;
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	bh = Tcl_GetByteArrayFromObj(haystack, &lh);
	end = bh + lh;

	try = bh + start;
	while (try + ln <= end) {
	    try = memchr(try, bn[0], end - try);

	    if (try == NULL) {
		return -1;
	    }
	    if (0 == memcmp(try+1, bn+1, ln-1)) {
		return (try - bh);
	    }
	    try++;
	}
	return -1;
    }

    lh = Tcl_GetCharLength(haystack);
    if (haystack->bytes && (lh == haystack->length)) {
	/* haystack is all single-byte chars */

	if (needle->bytes && (ln == needle->length)) {
	    /* needle is also all single-byte chars */
	    char *found = strstr(haystack->bytes + start, needle->bytes);

	    if (found) {
		return (found - haystack->bytes);
	    } else {
		return -1;
	    }
	} else {
	    /*
	     * Cannot find substring with a multi-byte char inside
	     * a string with no multi-byte chars.
	     */
	    return -1;
	}
    } else {
	Tcl_UniChar *try, *end, *uh;
	Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);

	uh = Tcl_GetUnicodeFromObj(haystack, &lh);
	end = uh + lh;

	try = uh + start;
	while (try + ln <= end) {
	    if ((*try == *un)
		    && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
		return (try - uh);
	    }
	    try++;
	}
	return -1;
    }
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclStringLast --
 *
 *	Implements the [string last] operation.
 *
 * Results:
 *	If needle is found as a substring of haystack, the index of the
 *	last instance of such a find is returned.  If needle is not present
 *	as a substring of haystack, -1 is returned.
 *
 * Side effects:
 *	needle and haystack may have their Tcl_ObjType changed.
 *
 *---------------------------------------------------------------------------
 */

int
TclStringLast(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    int last)
{
    int lh, ln = Tcl_GetCharLength(needle);

    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!
	 *
	 * 	TODO: When we one day make this a true substring
	 * 	finder, change this to "return 0"
	 */
	return -1;
    }

    if (ln > last + 1) {
	return -1;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *try, *bh;
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	bh = Tcl_GetByteArrayFromObj(haystack, &lh);

	if (last + 1 > lh) {
	    last = lh - 1;
	}
	try = bh + last + 1 - ln;
	while (try >= bh) {
	    if ((*try == bn[0])
		    && (0 == memcmp(try+1, bn+1, ln-1))) {
		return (try - bh);
	    }
	    try--;
	}
	return -1;
    }

    lh = Tcl_GetCharLength(haystack);
    if (last + 1 > lh) {
	last = lh - 1;
    }
    if (haystack->bytes && (lh == haystack->length)) {
	/* haystack is all single-byte chars */

	if (needle->bytes && (ln == needle->length)) {
	    /* needle is also all single-byte chars */

	    char *try = haystack->bytes + last + 1 - ln;
	    while (try >= haystack->bytes) {
		if ((*try == needle->bytes[0])
			&& (0 == memcmp(try+1, needle->bytes + 1, ln - 1))) {
		    return (try - haystack->bytes);
		}
		try--;
	    }
	    return -1;
	} else {
	    /*
	     * Cannot find substring with a multi-byte char inside
	     * a string with no multi-byte chars.
	     */
	    return -1;
	}
    } else {
	Tcl_UniChar *try, *uh;
	Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);

	uh = Tcl_GetUnicodeFromObj(haystack, &lh);

	try = uh + last + 1 - ln;
	while (try >= uh) {
	    if ((*try == un[0])
		    && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
		return (try - uh);
	    }
	    try--;
	}
	return -1;
    }
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclStringObjReverse --
 *
 *	Implements the [string reverse] operation.

Changes to tests/string.test.

752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
    list [string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ] $var
} {0 88}

catch {rename largest_int {}}

test string-7.1 {string last, too few args} {
    list [catch {string last a} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}}
test string-7.2 {string last, bad args} {
    list [catch {string last a b c} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test string-7.3 {string last, too many args} {
    list [catch {string last a b c d} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}}
test string-7.4 {string last} {
    string la xxx xxxx123xx345x678
} 1
test string-7.5 {string last} {
    string last xx xxxx123xx345x678
} 7
test string-7.6 {string last} {






|





|







752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
    list [string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ] $var
} {0 88}

catch {rename largest_int {}}

test string-7.1 {string last, too few args} {
    list [catch {string last a} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.2 {string last, bad args} {
    list [catch {string last a b c} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test string-7.3 {string last, too many args} {
    list [catch {string last a b c d} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.4 {string last} {
    string la xxx xxxx123xx345x678
} 1
test string-7.5 {string last} {
    string last xx xxxx123xx345x678
} 7
test string-7.6 {string last} {