Changes On Branch strict-index-experiment
Not logged in

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

Changes In Branch strict-index-experiment Excluding Merge-Ins

This is equivalent to a diff from af5e57f956 to 385eb80dc4

2022-02-16
16:52
Merge 8.6 check-in: 7e9fb8f7bd user: jan.nijtmans tags: core-8-branch
14:18
Merge 8.7 check-in: 9c9eb4873b user: jan.nijtmans tags: tip-615
12:15
Merge 8.7. Fix 2 test-cases Leaf check-in: 385eb80dc4 user: jan.nijtmans tags: strict-index-experiment
10:51
Merge 8.7 check-in: 78d22a5a49 user: jan.nijtmans tags: trunk, main
10:46
Merge 8.6 check-in: af5e57f956 user: jan.nijtmans tags: core-8-branch
10:36
Add x86_64-w64-mingw32-nmakehlp.exe as a helper, when cross-compiling check-in: cb2a5f77e3 user: jan.nijtmans tags: core-8-6-branch
2022-02-15
15:04
Tcl 8.7 requires Visual Studio 2015 or newer check-in: a2325dd904 user: jan.nijtmans tags: core-8-branch
2022-02-14
18:10
Merge 8.7 check-in: 27a9a7d379 user: jan.nijtmans tags: strict-index-experiment

Changes to generic/tclCmdMZ.c.
380
381
382
383
384
385
386




387
388
389

390
391
392
393
394
395
396
397
398
399
400
401
402
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396




397
398
399
400
401
402
403







+
+
+
+



+


-
-
-
-







		     * Adjust index so it refers to the last character in the
		     * match instead of the first character after the match.
		     */

		    if (end >= offset) {
			end--;
		    }
		    TclNewIndexObj(objs[0], start);
		    TclNewIndexObj(objs[1], end);

		    newPtr = Tcl_NewListObj(2, objs);
		} else {
		    start = TCL_INDEX_NONE;
		    end = TCL_INDEX_NONE;
		    TclNewObj(newPtr);
		}

		TclNewIndexObj(objs[0], start);
		TclNewIndexObj(objs[1], end);

		newPtr = Tcl_NewListObj(2, objs);
	    } else {
		if ((i <= info.nsubs) && (info.matches[i].end > 0)) {
		    newPtr = Tcl_GetRange(objPtr,
			    offset + info.matches[i].start,
			    offset + info.matches[i].end - 1);
		} else {
		    TclNewObj(newPtr);
3770
3771
3772
3773
3774
3775
3776


3777
3778
3779



3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780


3781
3782
3783
3784
3785
3786
3787
3788
3789


3790
3791
3792
3793
3794
3795
3796







+
+

-
-
+
+
+






-
-







	for (j=0 ; j<=info.nsubs ; j++) {
	    if (indexVarObj != NULL) {
		Tcl_Obj *rangeObjAry[2];

		if (info.matches[j].end > 0) {
		    TclNewIndexObj(rangeObjAry[0], info.matches[j].start);
		    TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1);
		    Tcl_ListObjAppendElement(NULL, indicesObj,
			    Tcl_NewListObj(2, rangeObjAry));
		} else {
		    TclNewIndexObj(rangeObjAry[1], TCL_INDEX_NONE);
		    rangeObjAry[0] = rangeObjAry[1];
		    TclNewIndexObj(rangeObjAry[0], TCL_INDEX_NONE);
		    Tcl_ListObjAppendElement(NULL, indicesObj,
			    rangeObjAry[0]);
		}

		/*
		 * Never fails; the object is always clean at this point.
		 */

		Tcl_ListObjAppendElement(NULL, indicesObj,
			Tcl_NewListObj(2, rangeObjAry));
	    }

	    if (matchVarObj != NULL) {
		Tcl_Obj *substringObj;

		substringObj = Tcl_GetRange(stringObj,
			info.matches[j].start, info.matches[j].end-1);
Changes to generic/tclInt.h.
2759
2760
2761
2762
2763
2764
2765

2766
2767
2768
2769
2770
2771
2772
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773







+







 */

MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteArrayType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclEndOffsetType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
4899
4900
4901
4902
4903
4904
4905



4906






4907
4908
4909
4910
4911
4912
4913
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909

4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922







+
+
+
-
+
+
+
+
+
+







	(objPtr)->bytes = NULL;				\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
	(objPtr)->typePtr = &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewIndexObj(objPtr, w) \
    do {						\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
    TclNewIntObj(objPtr, w)
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(((w) < 0) ? WIDE_MIN : (w));	\
	(objPtr)->typePtr = (w < 0) ? &tclEndOffsetType : &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewDoubleObj(objPtr, d) \
    do {							\
	TclIncrObjsAllocated();					\
	TclAllocObjStorage(objPtr);				\
	(objPtr)->refCount = 0;					\
	(objPtr)->bytes = NULL;					\
4927
4928
4929
4930
4931
4932
4933
4934

4935
4936
4937
4938
4939
4940
4941
4936
4937
4938
4939
4940
4941
4942

4943
4944
4945
4946
4947
4948
4949
4950







-
+







    } while (0)

#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj(w)

#define TclNewIndexObj(objPtr, w) \
    TclNewIntObj(objPtr, w)
    (objPtr) = ((w < 0) ? Tcl_NewObj() : Tcl_NewWideIntObj(w))

#define TclNewDoubleObj(objPtr, d) \
    (objPtr) = Tcl_NewDoubleObj(d)

#define TclNewStringObj(objPtr, s, len) \
    (objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */
Changes to generic/tclListObj.c.
1437
1438
1439
1440
1441
1442
1443
1444


1445
1446
1447
1448

1449
1450
1451
1452
1453
1454
1455
1437
1438
1439
1440
1441
1442
1443

1444
1445
1446
1447
1448

1449
1450
1451
1452
1453
1454
1455
1456







-
+
+



-
+







    int index;			/* Current index in the list - discarded. */
    Tcl_Obj *indexListCopy;
    List *listRepPtr;

    /*
     * Determine whether the index arg designates a list or a single index.
     * We have to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP #22 and #23 for details.
     * shimmering; see TIP #22 and #23 for details. Don't allow "" as single
     * index here, since it cannot be distinguished from an empty list.
     */

    ListGetInternalRep(indexArgPtr, listRepPtr);
    if (listRepPtr == NULL
    if (listRepPtr == NULL && Tcl_GetString(indexArgPtr)[0]
	    && TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX - 1, &index) == TCL_OK) {
	/*
	 * indexArgPtr designates a single index.
	 */

	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);

Changes to generic/tclNamesp.c.
149
150
151
152
153
154
155


156
157
158
159
160
161
162
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164







+
+







	(nnPtr) = irPtr ? (ResolvedNsName *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

/*
 * Array of values describing how to implement each standard subcommand of the
 * "namespace" command.
 */
#define TclCompileNamespaceQualifiersCmd NULL
#define TclCompileNamespaceTailCmd NULL

static const EnsembleImplMap defaultNamespaceMap[] = {
    {"children",   NamespaceChildrenCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
    {"code",	   NamespaceCodeCmd,	TclCompileNamespaceCodeCmd, NULL, NULL, 0},
    {"current",	   NamespaceCurrentCmd,	TclCompileNamespaceCurrentCmd, NULL, NULL, 0},
    {"delete",	   NamespaceDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"ensemble",   TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
Changes to generic/tclUtil.c.
120
121
122
123
124
125
126
127
128
129

130
131














132

133
134
135
136

137
138
139

140
141
142
143
144
145
146
120
121
122
123
124
125
126



127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

144
145
146
147

148
149
150

151
152
153
154
155
156
157
158







-
-
-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+



-
+


-
+







			    int *literalPtr);
/*
 * The following is the Tcl object type definition for an object that
 * represents a list index in the form, "end-offset". It is used as a
 * performance optimization in Tcl_GetIntForIndex. The internal rep is
 * stored directly in the wideValue, so no memory management is required
 * for it. This is a caching internalrep, keeping the result of a parse
 * around. This type is only created from a pre-existing string, so an
 * updateStringProc will never be called and need not exist. The type
 * is unregistered, so has no need of a setFromAnyProc either.
 * around. The type is unregistered, so has no need of a setFromAnyProc.
 */

static void
UpdateStringOfIndex(
    Tcl_Obj *objPtr)	/* Index object whose string rep to update. */
{
    /* The only situation that the string rep can be missing is when it
     * represents TCL_INDEX_NONE. In all other situations, the string
     * rep is never thrown away. See TclNewIndexObj() */
    if ((objPtr)->internalRep.wideValue != WIDE_MIN) {
	Tcl_Panic("String rep of index %" TCL_LL_MODIFIER "d cannot be generated",
		(long long)(objPtr)->internalRep.wideValue);
    }
    TclInitStringRep(objPtr, NULL, 0);
}

static const Tcl_ObjType endOffsetType = {
const Tcl_ObjType tclEndOffsetType = {
    "end-offset",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    UpdateStringOfIndex,		/* updateStringProc */
    NULL				/* setFromAnyProc */
};


/*
 *	*	STRING REPRESENTATION OF LISTS	*	*	*
 *
 * The next several routines implement the conversions of strings to and from
 * Tcl lists. To understand their operation, the rules of parsing and
 * generating the string representation of lists must be known.  Here we
 * describe them in one place.
3641
3642
3643
3644
3645
3646
3647









3648
3649
3650
3651
3652
3653
3654
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675







+
+
+
+
+
+
+
+
+







    Tcl_WideInt *widePtr)       /* Location filled in with a wide integer
                                 * representing an index. */
{
    int numType;
    ClientData cd;
    int code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);

#ifdef TCL_NO_DEPRECATED
    if (Tcl_GetString(objPtr)[0] == '-') {
	if (interp) {
	    Tcl_AppendResult(interp, "index \"", Tcl_GetString(objPtr),
		    "\" out of range", NULL);
	}
	return TCL_ERROR;
    }
#endif
    if (code == TCL_OK) {
	if (numType == TCL_NUMBER_INT) {
	    /* objPtr holds an integer in the signed wide range */
	    *widePtr = *(Tcl_WideInt *)cd;
	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
3754
3755
3756
3757
3758
3759
3760
3761

3762
3763
3764
3765
3766
3767
3768
3769
3770
3771





3772
3773
3774
3775
3776
3777
3778
3775
3776
3777
3778
3779
3780
3781

3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804







-
+










+
+
+
+
+







    Tcl_WideInt *widePtr)       /* Location filled in with an integer
                                 * representing an index. */
{
    Tcl_ObjInternalRep *irPtr;
    Tcl_WideInt offset = -1;	/* Offset in the "end-offset" expression - 1 */
    ClientData cd;

    while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) {
    while ((irPtr = TclFetchInternalRep(objPtr, &tclEndOffsetType)) == NULL) {
	Tcl_ObjInternalRep ir;
	int length;
	const char *bytes = TclGetStringFromObj(objPtr, &length);

	if (*bytes != 'e') {
	    int numType;
	    const char *opPtr;
	    int t1 = 0, t2 = 0;

	    /* Value doesn't start with "e" */

	    if (length == 0) {
		offset = WIDE_MIN;
		goto parseOK;
	    }

	    /* If we reach here, the string rep of objPtr exists. */

	    /*
	     * The valid index syntax does not include any value that is
	     * a list of more than one element. This is necessary so that
	     * lists of index values can be reliably distinguished from any
3940
3941
3942
3943
3944
3945
3946
3947

3948
3949
3950
3951
3952
3953
3954
3966
3967
3968
3969
3970
3971
3972

3973
3974
3975
3976
3977
3978
3979
3980







-
+







		}
	    }
	}

    parseOK:
	/* Success. Store the new internal rep. */
	ir.wideValue = offset;
	Tcl_StoreInternalRep(objPtr, &endOffsetType, &ir);
	Tcl_StoreInternalRep(objPtr, &tclEndOffsetType, &ir);
    }

    offset = irPtr->wideValue;

    if (offset == WIDE_MAX) {
	*widePtr = endValue + 1;
    } else if (offset == WIDE_MIN) {
4045
4046
4047
4048
4049
4050
4051
4052

4053
4054
4055
4056
4057
4058
4059
4071
4072
4073
4074
4075
4076
4077

4078
4079
4080
4081
4082
4083
4084
4085







-
+







    int after,		/* Value to return for index after end */
    int *indexPtr)	/* Where to write the encoded answer, not NULL */
{
    Tcl_WideInt wide;
    int idx;

    if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &endOffsetType);
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclEndOffsetType);
	if (irPtr && irPtr->wideValue >= 0) {
	    /* "int[+-]int" syntax, works the same here as "int" */
	    irPtr = NULL;
	}
	/*
	 * We parsed an end+offset index value.
	 * wide holds the offset value in the range WIDE_MIN...WIDE_MAX.
Changes to library/clock.tcl.
4167
4168
4169
4170
4171
4172
4173
4174

4175
4176
4177

4178
4179
4180
4181
4182
4183
4184
4167
4168
4169
4170
4171
4172
4173

4174
4175
4176

4177
4178
4179
4180
4181
4182
4183
4184







-
+


-
+







# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::BSearch { list key } {
    if {[llength $list] == 0} {
	return -1
	return {}
    }
    if { $key < [lindex $list 0 0] } {
	return -1
	return {}
    }

    set l 0
    set u [expr { [llength $list] - 1 }]

    while { $l < $u } {
	# At this point, we know that
Changes to library/word.tcl.
50
51
52
53
54
55
56
57

58
59
60
61
62
63
64
65
66
67

68
69
70
71
72
73
74
75

76
77
78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93
94
95

96
97
98
99
100
101
102
103
104

105
106
107
108
109
110
111
112
113

114
115
116
117
118
119
120
121
122

123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138

139
140
141
142
143
144
50
51
52
53
54
55
56

57
58
59
60
61
62
63
64
65
66

67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84

85
86
87
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102
103

104
105
106
107
108
109
110
111
112

113
114
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137

138
139
140
141
142
143
144







-
+









-
+







-
+









-
+









-
+








-
+








-
+








-
+















-
+






    trace add variable ::tcl_wordchars write ::tcl::UpdateWordBreakREs
    trace add variable ::tcl_nonwordchars write ::tcl::UpdateWordBreakREs
}

# tcl_wordBreakAfter --
#
# This procedure returns the index of the first word boundary after the
# starting point in the given string, or -1 if there are no more boundaries in
# starting point in the given string, or "" if there are no more boundaries in
# the given string. The index returned refers to the first character of the
# pair that comprises a boundary.
#
# Arguments:
# str -		String to search.
# start -	Index into string specifying starting point.

proc tcl_wordBreakAfter {str start} {
    variable ::tcl::WordBreakRE
    set result {-1 -1}
    set result {}
    regexp -indices -start $start -- $WordBreakRE(after) $str result
    return [lindex $result 1]
}

# tcl_wordBreakBefore --
#
# This procedure returns the index of the first word boundary before the
# starting point in the given string, or -1 if there are no more boundaries in
# starting point in the given string, or " if there are no more boundaries in
# the given string. The index returned refers to the second character of the
# pair that comprises a boundary.
#
# Arguments:
# str -		String to search.
# start -	Index into string specifying starting point.

proc tcl_wordBreakBefore {str start} {
    variable ::tcl::WordBreakRE
    set result {-1 -1}
    set result {}
    regexp -indices -- $WordBreakRE(before) [string range $str 0 $start] result
    return [lindex $result 1]
}

# tcl_endOfWord --
#
# This procedure returns the index of the first end-of-word location after a
# starting index in the given string. An end-of-word location is defined to be
# the first whitespace character following the first non-whitespace character
# after the starting point. Returns -1 if there are no more words after the
# after the starting point. Returns "" if there are no more words after the
# starting point.
#
# Arguments:
# str -		String to search.
# start -	Index into string specifying starting point.

proc tcl_endOfWord {str start} {
    variable ::tcl::WordBreakRE
    set result {-1 -1}
    set result {}
    regexp -indices -start $start -- $WordBreakRE(end) $str result
    return [lindex $result 1]
}

# tcl_startOfNextWord --
#
# This procedure returns the index of the first start-of-word location after a
# starting index in the given string. A start-of-word location is defined to
# be a non-whitespace character following a whitespace character. Returns -1
# be a non-whitespace character following a whitespace character. Returns ""
# if there are no more start-of-word locations after the starting point.
#
# Arguments:
# str -		String to search.
# start -	Index into string specifying starting point.

proc tcl_startOfNextWord {str start} {
    variable ::tcl::WordBreakRE
    set result {-1 -1}
    set result {}
    regexp -indices -start $start -- $WordBreakRE(next) $str result
    return [lindex $result 1]
}

# tcl_startOfPreviousWord --
#
# This procedure returns the index of the first start-of-word location before
# a starting index in the given string.
#
# Arguments:
# str -		String to search.
# start -	Index into string specifying starting point.

proc tcl_startOfPreviousWord {str start} {
    variable ::tcl::WordBreakRE
    set word {-1 -1}
    set word {}
    if {$start > 0} {
	regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \
		result word
    }
    return [lindex $word 0]
}
Changes to tests/assemble.test.
1559
1560
1561
1562
1563
1564
1565
1566

1567
1568
1569
1570
1571
1572
1573
1559
1560
1561
1562
1563
1564
1565

1566
1567
1568
1569
1570
1571
1572
1573







-
+







test assemble-15.7 {listIndexImm} -body {
    assemble {push {a b c}; listIndexImm end}
} -result c
test assemble-15.8 {listIndexImm} -body {
    assemble {push {a b c}; listIndexImm end+2}
} -result {}
test assemble-15.9 {listIndexImm} -body {
    assemble {push {a b c}; listIndexImm -1-1}
    assemble {push {a b c}; listIndexImm {}}
} -result {}

# assemble-16 - invokeStk

test assemble-16.1 {invokeStk - wrong # args} {
    -body {
	assemble {invokeStk}
Changes to tests/cmdIL.test.
801
802
803
804
805
806
807
808

809
810
811
812
813
814
815
801
802
803
804
805
806
807

808
809
810
811
812
813
814
815







-
+







test cmdIL-8.3 {lremove command: error path} -returnCodes error -body {
    lremove {a b c} gorp
} -result {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}
test cmdIL-8.4 {lremove command: no indices} -body {
    lremove {a b c}
} -result {a b c}
test cmdIL-8.5 {lremove command: before start} -body {
    lremove {a b c} -1
    lremove {a b c} {}
} -result {a b c}
test cmdIL-8.6 {lremove command: after end} -body {
    lremove {a b c} 3
} -result {a b c}
test cmdIL-8.7 {lremove command} -body {
    lremove {a b c} 0
} -result {b c}
Changes to tests/indexObj.test.
166
167
168
169
170
171
172
173

174
175

176
177
178
179
180
181
182
166
167
168
169
170
171
172

173
174

175
176
177
178
179
180
181
182







-
+

-
+







    testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0
} {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}}

test indexObj-8.1 {Tcl_GetIntForIndex integer} testgetintforindex {
    testgetintforindex 0 0
} 0
test indexObj-8.2 {Tcl_GetIntForIndex integer} testgetintforindex {
    testgetintforindex -1 0
    testgetintforindex {} 0
} -1
test indexObj-8.3 {Tcl_GetIntForIndex integer} testgetintforindex {
test indexObj-8.3 {Tcl_GetIntForIndex integer} {testgetintforindex deprecated} {
    testgetintforindex -2 0
} -1
test indexObj-8.4 {Tcl_GetIntForIndex INT_MAX} testgetintforindex {
    testgetintforindex 2147483647 0
} 2147483647
test indexObj-8.5 {Tcl_GetIntForIndex INT_MAX+1} testgetintforindex {
    testgetintforindex 2147483648 0
Changes to tests/lindex.test.
16
17
18
19
20
21
22
23

24
25
26
27
28
29
30
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30







-
+







    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

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

set minus -
set none {}
testConstraint testevalex [llength [info commands testevalex]]

# Tests of Tcl_LindexObjCmd, NOT COMPILED

test lindex-1.1 {wrong # args} testevalex {
    list [catch {testevalex lindex} result] $result
} "1 {wrong # args: should be \"lindex list ?index ...?\"}"
48
49
50
51
52
53
54
55

56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

76
77
78
79
80
81
82
83

84
85
86

87
88
89
90
91
92
93
48
49
50
51
52
53
54

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82

83
84
85

86
87
88
89
90
91
92
93







-
+



















-
+







-
+


-
+







    set x \{
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}

# Indices that are integers or convertible to integers

test lindex-3.1 {integer -1} -constraints testevalex -body {
    set x ${minus}1
    set x ${none}${none}
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} -result {{} {}}
test lindex-3.2 {integer 0} -constraints testevalex -body {
    set x [string range 00 0 0]
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} -result {a a}
test lindex-3.3 {integer 2} -constraints testevalex -body {
    set x [string range 22 0 0]
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} -result {c c}
test lindex-3.4 {integer 3} -constraints testevalex -body {
    set x [string range 33 0 0]
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} -result {{} {}}
test lindex-3.5 {bad octal} -constraints testevalex -body {
    set x 0o8
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*invalid octal number*}}
test lindex-3.6 {bad octal} -constraints testevalex -body {
    set x -0o9
    set x 0o9
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*invalid octal number*}}
test lindex-3.7 {indexes don't shimmer wide ints} -body {
    set x [expr {(wide(1)<<31) - 2}]
    list $x [lindex {1 2 3} $x] [incr x] [incr x]
} -result {2147483646 {} 2147483647 2147483648}
test lindex-3.8 {compiled with static indices out of range, negative} -body {
    list [lindex {a b c} -1] [lindex {a b c} -2] [lindex {a b c} -3]
    list [lindex {a b c} {}] [lindex {a b c} {}] [lindex {a b c} {}]
} -result [lrepeat 3 {}]
test lindex-3.9 {compiled with calculated indices out of range, negative constant} -body {
    list [lindex {a b c} -1-1] [lindex {a b c} -2+0] [lindex {a b c} -2+1]
    list [lindex {a b c} 0-2] [lindex {a b c} 1-3] [lindex {a b c} 2-4]
} -result [lrepeat 3 {}]
test lindex-3.10 {compiled with calculated indices out of range, after end} -body {
    list [lindex {a b c} end+1] [lindex {a b c} end+2] [lindex {a b c} end+3]
} -result [lrepeat 3 {}]

# Indices relative to end

239
240
241
242
243
244
245
246
247


248
249
250
251
252
253
254
239
240
241
242
243
244
245


246
247
248
249
250
251
252
253
254







-
-
+
+







test lindex-10.4 {malformed index list} {
    set x \{
    list [catch { lindex {a b c} $x } result] $result
} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}

# Indices that are integers or convertible to integers

test lindex-11.1 {integer -1} {
    set x ${minus}1
test lindex-11.1 {index {}} {
    set x ${none}${none}
    catch {
	list [lindex {a b c} $x] [lindex {a b c} $x]
    } result
    set result
} {{} {}}
test lindex-11.2 {integer 0} {
    set x [string range 00 0 0]
272
273
274
275
276
277
278
279

280
281
282
283
284
285
286
272
273
274
275
276
277
278

279
280
281
282
283
284
285
286







-
+







    set result
} {{} {}}
test lindex-11.5 {bad octal} -body {
    set x 0o8
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*invalid octal number*}}
test lindex-11.6 {bad octal} -body {
    set x -0o9
    set x 0o9
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*invalid octal number*}}

# Indices relative to end

test lindex-12.1 {index = end} {
    set x end
Changes to tests/listObj.test.
100
101
102
103
104
105
106
107

108
109
110
111
112
113
114
100
101
102
103
104
105
106

107
108
109
110
111
112
113
114







-
+







test listobj-5.5 {Tcl_ListObjIndex, basic tests} {
    lindex {a b c} 100
} {}
test listobj-5.6 {Tcl_ListObjIndex, basic tests} {
    lindex a 100
} {}
test listobj-5.7 {Tcl_ListObjIndex, basic tests} {
    lindex {} -1
    lindex {} {}
} {}
test listobj-5.8 {Tcl_ListObjIndex, error in conversion} {
    set x " \{"
    list [catch {lindex $x 0} msg] $msg
} {1 {unmatched open brace in list}}

test listobj-6.1 {Tcl_ListObjLength} {
136
137
138
139
140
141
142
143

144
145
146
147
148
149
150
136
137
138
139
140
141
142

143
144
145
146
147
148
149
150







-
+







test listobj-7.2 {Tcl_ListObjReplace, error converting from non-list} {
    list [catch {lreplace "a b c \{" 1 1 x} msg] $msg
} {1 {unmatched open brace in list}}
test listobj-7.3 {Tcl_ListObjReplace, error converting from non-list} {
    list [catch {lreplace "a {b}c" 1 2 x} msg] $msg
} {1 {list element in braces followed by "c" instead of space}}
test listobj-7.4 {Tcl_ListObjReplace, negative first element index} {
    lreplace {1 2 3 4 5} -1 1 a
    lreplace {1 2 3 4 5} {} 1 a
} {a 3 4 5}
test listobj-7.5 {Tcl_ListObjReplace, last element index >= num elems} {
    lreplace {1 2 3 4 5} 3 7 a b c
} {1 2 3 a b c}
test listobj-7.6 {Tcl_ListObjReplace, first element index > last index} {
    lreplace {1 2 3 4 5} 3 1 a b c
} {1 2 3 a b c 4 5}
160
161
162
163
164
165
166
167

168
169
170
171
172
173
174
160
161
162
163
164
165
166

167
168
169
170
171
172
173
174







-
+







test listobj-7.10 {Tcl_ListObjReplace, replace tail of array} {
    lreplace {1 2 3 4 5 6 7} 3 6 a
} {1 2 3 a}
test listobj-7.11 {Tcl_ListObjReplace, must grow internal array} {
    lreplace {1 2 3 4 5} 2 3 a b c d e f g h i j k l
} {1 2 a b c d e f g h i j k l 5}
test listobj-7.12 {Tcl_ListObjReplace, grow array, insert at start} {
    lreplace {1 2 3 4 5} -1 -1 a b c d e f g h i j k l
    lreplace {1 2 3 4 5} {} {} a b c d e f g h i j k l
} {a b c d e f g h i j k l 1 2 3 4 5}
test listobj-7.13 {Tcl_ListObjReplace, grow array, insert at end} {
    lreplace {1 2 3 4 5} 4 1 a b c d e f g h i j k l
} {1 2 3 4 a b c d e f g h i j k l 5}

test listobj-8.1 {SetListFromAny} {
    lindex {0 foo\x00help 2} 1
Changes to tests/lpop.test.
42
43
44
45
46
47
48
49

50
51
52
53
54
55
56
42
43
44
45
46
47
48

49
50
51
52
53
54
55
56







-
+







test lpop-1.6 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l end+1
} -result {index "end+1" out of range}
test lpop-1.7 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l {}
} -match glob -result {bad index *}
} -match glob -result {index "" out of range}
test lpop-1.8 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l 0 0 0 0 1
} -result {index "1" out of range}
test lpop-1.9 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l {1 0}
Changes to tests/lrange.test.
36
37
38
39
40
41
42
43

44
45
46

47
48
49

50
51
52
53
54
55
56
36
37
38
39
40
41
42

43
44
45

46
47
48

49
50
51
52
53
54
55
56







-
+


-
+


-
+







test lrange-1.5 {range of list elements} {
    lrange {a {bcd e {f g {}}} l14 l15 d} 4 3
} {}
test lrange-1.6 {range of list elements} {
    lrange {a {bcd e {f g {}}} l14 l15 d} 10 11
} {}
test lrange-1.7 {range of list elements} {
    lrange {a b c d e} -1 2
    lrange {a b c d e} {} 2
} {a b c}
test lrange-1.8 {range of list elements} {
    lrange {a b c d e} -2 -1
    lrange {a b c d e} {} {}
} {}
test lrange-1.9 {range of list elements} {
    lrange {a b c d e} -2 end
    lrange {a b c d e} {} end
} {a b c d e}
test lrange-1.10 {range of list elements} {
    lrange "a b\{c d" 1 2
} "b\\{c d"
test lrange-1.11 {range of list elements} {
    lrange "a b c d" end end
} d
92
93
94
95
96
97
98
99

100
101
102

103
104
105
106
107
108
109

110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128


129
130
131
132
133


134
135
136
137
138
139
140
92
93
94
95
96
97
98

99
100
101

102
103
104
105
106
107
108

109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126


127
128
129
130
131


132
133
134
135
136
137
138
139
140







-
+


-
+






-
+

















-
-
+
+



-
-
+
+








test lrange-3.1 {Bug 3588366: end-offsets before start} {
    apply {l {
	lrange $l 0 end-5
    }} {1 2 3 4 5}
} {}
test lrange-3.2 {compiled with static indices out of range, negative} {
    list [lrange {a b c} -1 -2] [lrange {a b c} -2 -1] [lrange {a b c} -3 -2] [lrange {a b c} -2 -3]
    list [lrange {a b c} {} {}] [lrange {a b c} {} {}] [lrange {a b c} {} {}] [lrange {a b c} {} {}]
} [lrepeat 4 {}]
test lrange-3.3 {compiled with calculated indices out of range, negative constant} {
    list [lrange {a b c} 0-1 -1-1] [lrange {a b c} -2+0 0-1] [lrange {a b c} -2-1 -2+1] [lrange {a b c} -2+1 -2-1]
    list [lrange {a b c} 0-1 0-2] [lrange {a b c} 1-3 0-1] [lrange {a b c} 1-4 1+-2] [lrange {a b c} 1+-2 1-4]
} [lrepeat 4 {}]
test lrange-3.4 {compiled with calculated indices out of range, after end} -body {
    list [lrange {a b c} end+1 end+2] [lrange {a b c} end+2 end+1] [lrange {a b c} end+2 end+3] [lrange {a b c} end+3 end+2]
} -result [lrepeat 4 {}]

test lrange-3.5 {compiled with calculated indices, start out of range (negative)} {
    list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1]
    list [lrange {a b c} {} 1] [lrange {a b c} 0+-1 end-1] [lrange {a b c} {} 1] [lrange {a b c} 0+-2 0+1]
} [lrepeat 4 {a b}]
test lrange-3.6 {compiled with calculated indices, end out of range (after end)} {
    list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1]
} [lrepeat 4 {b c}]

test lrange-3.7a {compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} {
    list [lrange { } 0 1] [lrange [format %c 32] 0 1] [lrange [set a { }] 0 1] \
	 [lrange { } 0-1 end+1] [lrange [format %c 32] 0-1 end+1] [lrange $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} -body {
    set cmd lrange
    list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \
	 [$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1]
} -result [lrepeat 6 {}]
# following 4 tests could cause a segfault on empty non-lists with tclEmptyStringRep
# (as before the fix [58c46e74b931d3a1]):
test lrange-3.7a.2 {compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} {
    list [lrange {} 0 1] [lrange [lindex a -1] 0 1] [lrange [set a {}] 0 1] \
	 [lrange {} 0-1 end+1] [lrange [lindex a -1] 0-1 end+1] [lrange $a 0-1 end+1]
    list [lrange {} 0 1] [lrange [lindex a {}] 0 1] [lrange [set a {}] 0 1] \
	 [lrange {} 0-1 end+1] [lrange [lindex a {}] 0-1 end+1] [lrange $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} -body {
    set cmd lrange
    list [$cmd {} 0 1] [$cmd [lindex a -1] 0 1] [$cmd [set a {}] 0 1] \
	 [$cmd {} 0-1 end+1] [$cmd [lindex a -1] 0-1 end+1] [$cmd $a 0-1 end+1]
    list [$cmd {} 0 1] [$cmd [lindex a {}] 0 1] [$cmd [set a {}] 0 1] \
	 [$cmd {} 0-1 end+1] [$cmd [lindex a {}] 0-1 end+1] [$cmd $a 0-1 end+1]
} -result [lrepeat 6 {}]
test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints {
    testpurebytesobj
} -body {
    list [lrange [testpurebytesobj] 0 1] [lrange [testpurebytesobj { }] 0 1] [lrange [set a [testpurebytesobj {}]] 0 1] \
	 [lrange [testpurebytesobj] 0-1 end+1] [lrange [testpurebytesobj { }] 0-1 end+1] [lrange $a 0-1 end+1]
} -result [lrepeat 6 {}]
Changes to tests/lreplace.test.
31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
31
32
33
34
35
36
37

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

59
60
61
62
63
64
65
66







-
+




















-
+







test lreplace-1.5 {lreplace command} {
    lreplace {1 2 3 4 5} 4 4 a
} {1 2 3 4 a}
test lreplace-1.6 {lreplace command} {
    lreplace {1 2 3 4 5} 4 5 a
} {1 2 3 4 a}
test lreplace-1.7 {lreplace command} {
    lreplace {1 2 3 4 5} -1 -1 a
    lreplace {1 2 3 4 5} {} {} a
} {a 1 2 3 4 5}
test lreplace-1.8 {lreplace command} {
    lreplace {1 2 3 4 5} 2 end a b c d
} {1 2 a b c d}
test lreplace-1.9 {lreplace command} {
    lreplace {1 2 3 4 5} 0 3
} {5}
test lreplace-1.10 {lreplace command} {
    lreplace {1 2 3 4 5} 0 4
} {}
test lreplace-1.11 {lreplace command} {
    lreplace {1 2 3 4 5} 0 1
} {3 4 5}
test lreplace-1.12 {lreplace command} {
    lreplace {1 2 3 4 5} 2 3
} {1 2 5}
test lreplace-1.13 {lreplace command} {
    lreplace {1 2 3 4 5} 3 end
} {1 2 3}
test lreplace-1.14 {lreplace command} {
    lreplace {1 2 3 4 5} -1 4 a b c
    lreplace {1 2 3 4 5} {} 4 a b c
} {a b c}
test lreplace-1.15 {lreplace command} {
    lreplace {a b "c c" d e f} 3 3
} {a b {c c} e f}
test lreplace-1.16 {lreplace command} {
    lreplace { 1 2 3 4 5} 0 0 a
} {a 2 3 4 5}
79
80
81
82
83
84
85
86

87
88
89

90
91
92
93
94
95
96
79
80
81
82
83
84
85

86
87
88

89
90
91
92
93
94
95
96







-
+


-
+







test lreplace-1.21 {lreplace command} {
    lreplace {1 2 3 4} end 3 a
} {1 2 3 a}
test lreplace-1.22 {lreplace command} {
    lreplace {1 2 3 4} end end
} {1 2 3}
test lreplace-1.23 {lreplace command} {
    lreplace {1 2 3 4} 2 -1 xy
    lreplace {1 2 3 4} 2 {} xy
} {1 2 xy 3 4}
test lreplace-1.24 {lreplace command} {
    lreplace {1 2 3 4} end -1 z
    lreplace {1 2 3 4} end {} z
} {1 2 3 z 4}
test lreplace-1.25 {lreplace command} {
    concat \"[lreplace {\}\     hello} end end]\"
} {"\}\ "}
test lreplace-1.26 {lreplace command} {
    catch {unset foo}
    set foo {a b}
Changes to tests/lsearch.test.
17
18
19
20
21
22
23
24
25


26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41


42
43
44


45
46
47
48
49
50
51
17
18
19
20
21
22
23


24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39


40
41
42


43
44
45
46
47
48
49
50
51







-
-
+
+














-
-
+
+

-
-
+
+







}

set x {abcd bbcd 123 234 345}
test lsearch-1.1 {lsearch command} {
    lsearch $x 123
} 2
test lsearch-1.2 {lsearch command} {
    lsearch $x 3456
} -1
    expr {[lsearch $x 3456]<0}
} 1
test lsearch-1.3 {lsearch command} {
    lsearch $x *5
} 4
test lsearch-1.4 {lsearch command} {
    lsearch $x *bc*
} 0

test lsearch-2.1 {search modes} {
    lsearch -exact {xyz bbcc *bc*} *bc*
} 2
test lsearch-2.2 {search modes} {
    lsearch -exact {b.x ^bc xy bcx} ^bc
} 1
test lsearch-2.3 {search modes} {
    lsearch -exact {foo bar cat} ba
} -1
    expr {[lsearch -exact {foo bar cat} ba]<0}
} 1
test lsearch-2.4 {search modes} {
    lsearch -exact {foo bar cat} bart
} -1
    expr {[lsearch -exact {foo bar cat} bart]<0}
} 1
test lsearch-2.5 {search modes} {
    lsearch -exact {foo bar cat} bar
} 1
test lsearch-2.6 {search modes} -returnCodes error -body {
    lsearch -regexp {xyz bbcc *bc*} *bc*
} -result {couldn't compile regular expression pattern: quantifier operand invalid}
test lsearch-2.7 {search modes} {
289
290
291
292
293
294
295
296
297


298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313

314
315
316
317


318
319
320
321


322
323
324
325
326
327
328
329
330
331
332
333
334
335
336


337
338
339
340
341
342
343
289
290
291
292
293
294
295


296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312

313
314
315


316
317
318
319


320
321
322
323
324
325
326
327
328
329
330
331
332
333
334


335
336
337
338
339
340
341
342
343







-
-
+
+















-
+


-
-
+
+


-
-
+
+













-
-
+
+







    set res
} [list 6 5 4 3 2 1 0]

test lsearch-10.1 {offset searching} {
    lsearch -start 2 {a b c a b c} a
} 3
test lsearch-10.2 {offset searching} {
    lsearch -start 2 {a b c d e f} a
} -1
    expr {[lsearch -start 2 {a b c d e f} a]<0}
} 1
test lsearch-10.3 {offset searching} {
    lsearch -start end-4 {a b c a b c} a
} 3
test lsearch-10.4 {offset searching} -returnCodes error -body {
    lsearch -start foobar {a b c a b c} a
} -result {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}
test lsearch-10.5 {offset searching} -returnCodes error -body {
    lsearch -start 1 2
} -result {missing starting index}
test lsearch-10.6 {binary search with offset} {
    set res {}
    for {set i 0} {$i < 100} {incr i} {
	lappend res [lsearch -integer -start 2 -sorted $increasingIntegers $i]
    }
    set res
} [concat -1 -1 [lrange $increasingIntegers 2 end]]
} [concat {{}} {{}} [lrange $increasingIntegers 2 end]]
test lsearch-10.7 {offset searching with an empty list} {
    # Stop bug #694232 from reocurring
    lsearch -start 0 {} x
} -1
    expr {[lsearch -start 0 {} x]<0}
} 1
test lsearch-10.8 {offset searching past the end of the list} {
    # Stop [Bug 1374778] from reoccurring
    lsearch -start 10 {a b c} c
} -1
    expr {[lsearch -start 10 {a b c} c]<0}
} 1
test lsearch-10.9 {offset searching past the end of the list} {
    # Stop [Bug 1374778] from reoccurring
    lsearch -start 10 -all {a b c} c
} {}
test lsearch-10.10 {offset searching past the end of the list} {
    # Stop [Bug 1374778] from reoccurring
    lsearch -start 10 -inline {a b c} c
} {}

test lsearch-11.1 {negated searches} {
    lsearch -not {a a a b a a a} a
} 3
test lsearch-11.2 {negated searches} {
    lsearch -not {a a a a a a a} a
} -1
    expr {[lsearch -not {a a a a a a a} a]<0}
} 1

test lsearch-12.1 {return values instead of indices} {
    lsearch -glob -inline {a1 b2 c3 d4} c*
} c3
test lsearch-12.2 {return values instead of indices} {
    lsearch -glob -inline {a1 b2 c3 d4} e*
} {}
510
511
512
513
514
515
516
517

518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533

534
535
536
537
538
539
540
510
511
512
513
514
515
516

517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532

533
534
535
536
537
538
539
540







-
+















-
+







test lsearch-22.1 {lsearch -bisect} -setup {
    set res {}
} -body {
    foreach i {0 1 5 6 7 8 15 16} {
	lappend res [lsearch -bisect -integer {1 4 5 7 9 15} $i]
    }
    return $res
} -result {-1 0 2 2 3 3 5 5}
} -result {{} 0 2 2 3 3 5 5}
test lsearch-22.2 {lsearch -bisect, last of equals} -setup {
    set res {}
} -body {
    foreach i {0 1 2 3} {
	lappend res [lsearch -bisect -integer {0 0 1 1 1 2 2 2 3 3 3} $i]
    }
    return $res
} -result {1 4 7 10}
test lsearch-22.3 {lsearch -bisect decreasing order} -setup {
    set res {}
} -body {
    foreach i {0 1 5 6 7 8 15 16} {
	lappend res [lsearch -bisect -integer -decreasing {15 9 7 5 4 1} $i]
    }
    return $res
} -result {5 5 3 2 2 1 0 -1}
} -result {5 5 3 2 2 1 0 {}}
test lsearch-22.4 {lsearch -bisect, last of equals, decreasing} -setup {
    set res {}
} -body {
    foreach i {0 1 2 3} {
	lappend res [lsearch -bisect -integer -decreasing \
		{3 3 3 2 2 2 1 1 1 0 0} $i]
    }
561
562
563
564
565
566
567
568
569


570
571
572
573
574
575


576
577
578
579
580
581
582
561
562
563
564
565
566
567


568
569
570
571
572
573


574
575
576
577
578
579
580
581
582







-
-
+
+




-
-
+
+







} -returnCodes error -result {list size must be a multiple of the stride length}
test lsearch-23.5 {lsearch -stride option, errors} -body {
    # Stride equal to length is ok
    lsearch -stride 3 {a b c} a
} -result 0

test lsearch-24.1 {lsearch -stride option} -body {
    lsearch -stride 2 {a b c d e f g h} d
} -result -1
    expr {[lsearch -stride 2 {a b c d e f g h} d]<0}
} -result 1
test lsearch-24.2 {lsearch -stride option} -body {
    lsearch -stride 2 {a b c d e f g h} e
} -result 4
test lsearch-24.3 {lsearch -stride option} -body {
    lsearch -stride 3 {a b c d e f g h i} e
} -result -1
    expr {[lsearch -stride 3 {a b c d e f g h i} e]<0}
} -result 1
test lsearch-24.4 {lsearch -stride option} -body {
    # Result points first in group
    lsearch -stride 3 -index 1 {a b c d e f g h i} e
} -result 3
test lsearch-24.5 {lsearch -stride option} -body {
    lsearch -inline -stride 2 {a b c d e f g h} d
} -result {}
661
662
663
664
665
666
667
668
669


670
671
672
673
674
675


676
677
678
679
680
681


682
683
684
685
686
687
688
661
662
663
664
665
666
667


668
669
670
671
672
673


674
675
676
677
678
679


680
681
682
683
684
685
686
687
688







-
-
+
+




-
-
+
+




-
-
+
+







    lsearch -inline -stride 3 -subindices -all -index {1 0} -exact {{a c} {a b} {d a} {x c} {a b} {d a}} a
} {a a}

test lsearch-28.1 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 5
} -result 0
test lsearch-28.2 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 3
} -result -1
    expr {[lsearch -sorted -stride 2 {5 3 7 8 9 2} 3]<0}
} -result 1
test lsearch-28.3 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 7
} -result 2
test lsearch-28.4 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 8
} -result -1
    expr {[lsearch -sorted -stride 2 {5 3 7 8 9 2} 8]<0}
} -result 1
test lsearch-28.5 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 9
} -result 4
test lsearch-28.6 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 2
} -result -1
    expr {[lsearch -sorted -stride 2 {5 3 7 8 9 2} 2]<0}
} -result 1
test lsearch-28.7 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 0 -subindices {5 3 7 8 9 2} 9
} -result 4
test lsearch-28.8 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 1 -subindices {3 5 8 7 2 9} 9
} -result 5
test lsearch-28.9 {lsearch -sorted with -stride} -body {
Changes to tests/ooUtil.test.
155
156
157
158
159
160
161
162

163
164
165
166
167
168
169
155
156
157
158
159
160
161

162
163
164
165
166
167
168
169







-
+







	}
	# This is confirming that this is not the parent interpreter
	list [Table find foo bar] [info globals childinterp]
    }
} -cleanup {
    interp delete $childinterp
} -result {{::Table called with arguments: foo bar} {}}
test ooUtil-1.9 {TIP 478: classmethod in safe child interp} -setup {
test ooUtil-1.9 {TIP 478: classmethod in safe interp} -setup {
    set safeinterp [interp create -safe]
} -body {
    $safeinterp eval {
	oo::class create ActiveRecord {
	    classmethod find args {
		return "[self] called with arguments: $args"
	    }
Changes to tests/regexp.test.
183
184
185
186
187
188
189
190

191
192
193
194

195
196
197
198
199
200
201
183
184
185
186
187
188
189

190
191
192
193

194
195
196
197
198
199
200
201







-
+



-
+







	    12223345556789999 \
	    foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \
	    $f6 $f7 $f8 $f9
} {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}}
test regexp-3.6 {getting substrings back from regexp} {
    set foo 2; set f2 2; set f3 2; set f4 2
    list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
} {1 {1 1} {1 1} {-1 -1} {-1 -1}}
} {1 {1 1} {1 1} {} {}}
test regexp-3.7 {getting substrings back from regexp} {
    set foo 1; set f2 1; set f3 1; set f4 1
    list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
} {1 {1 2} {1 1} {-1 -1} {2 2}}
} {1 {1 2} {1 1} {} {2 2}}
test regexp-3.8a {-indices by multi-byte utf-8} {
    regexp -inline -indices {(\w+)-(\w+)} \
	"grüß-привет"
} {{0 10} {0 3} {5 10}}
test regexp-3.8b {-indices by multi-byte utf-8, from -start position} {
    list\
	[regexp -inline -indices -start 3 {(\w+)-(\w+)} \
551
552
553
554
555
556
557
558

559
560
561
562
563
564
565
551
552
553
554
555
556
557

558
559
560
561
562
563
564
565







-
+







    exec [interpreter] $junk
} -cleanup {
    removeFile junk.tcl
} -result 1

test regexp-15.1 {regexp -start} -body {
    unset -nocomplain x
    list [regexp -start -10 {\d} 1abc2de3 x] $x
    list [regexp -start {} {\d} 1abc2de3 x] $x
} -result {1 1}
test regexp-15.2 {regexp -start} -body {
    unset -nocomplain x
    list [regexp -start 2 {\d} 1abc2de3 x] $x
} -result {1 2}
test regexp-15.3 {regexp -start} -body {
    unset -nocomplain x
597
598
599
600
601
602
603
604

605
606
607
608
609
610
611
597
598
599
600
601
602
603

604
605
606
607
608
609
610
611







-
+








test regexp-16.1 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} -result {4 a1b/2c/3d/4e/5}
test regexp-16.2 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start -25 {z} hello {/&} x] $x
    list [regsub -all -start {} {z} hello {/&} x] $x
} -result {0 hello}
test regexp-16.3 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start 3 {z} hello {/&} x] $x
} -result {0 hello}
test regexp-16.4 {regsub -start, \A behavior} -body {
    set out {}
662
663
664
665
666
667
668
669

670
671
672
673
674
675
676
662
663
664
665
666
667
668

669
670
671
672
673
674
675
676







-
+







} -result {1 xy}
test regexp-16.18 {regsub -start} -body {
    set foo {}
    list [regsub -start 1 y+ "xy" & foo] $foo
} -result {1 xy}
test regexp-16.19 {regsub -start} -body {
    set foo {}
    list [regsub -start -1 a+ "" & foo] $foo
    list [regsub -start {} a+ "" & foo] $foo
} -result {0 {}}
test regexp-16.20 {regsub -start, loss of ^$ behavior} -body {
    set foo NA
    list [regsub -start 1 {^$} {} & foo] $foo
} -result {0 {}}
test regexp-16.21 {regsub -start, loss of ^$ behavior} -body {
    set foo NA
748
749
750
751
752
753
754
755

756
757
758
759
760
761
762
748
749
750
751
752
753
754

755
756
757
758
759
760
761
762







-
+







    regexp -all -inline {a*} aba
} {a {} a}
test regexp-18.11 {regexp -all} {
    regexp -all -inline {^a} aaaa
} {a}
test regexp-18.12 {regexp -all -inline -indices} {
    regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh
} {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}}
} {{0 4} {1 3} {2 2} {} {5 9} {6 8} {} {7 7}}

test regexp-19.1 {regsub null replacement} {
    regsub -all {@} {@hel@lo@} "\0a\0" result
    list $result [string length $result]
} "\0a\0hel\0a\0lo\0a\0 14"

test regexp-19.2 {regsub null replacement} {
811
812
813
814
815
816
817
818

819
820
821
822
823
824
825
811
812
813
814
815
816
817

818
819
820
821
822
823
824
825







-
+







    regsub -all -line -- ^ "a\nb\nc" \#
} "\#a\n\#b\n\#c"
test regexp-21.12 {multiple matches handle newlines} {
    regsub -all -line -- ^ "\n\n" \#
} "\#\n\#\n\#"
test regexp-21.13 {multiple matches handle newlines} {
    regexp -all -inline -indices -line -- ^ "a\nb\nc"
} {{0 -1} {2 1} {4 3}}
} {{0 {}} {2 1} {4 3}}
test regexp-21.14 {regsub works with empty string} {
    regsub -- ^ {} &
} {}
test regexp-21.15 {regsub works with empty string} {
    regsub -- ^ {} foo&
} {foo}
test regexp-21.16 {regsub works with empty string} {
908
909
910
911
912
913
914
915

916
917
918
919
920
921
922

923
924
925
926
927
928
929

930
931
932
933
934
935
936

937
938
939
940
941
942
943
944
945
946
947
948
949
950

951
952
953
954
955
956
957
958
959
960
961
962
963
964

965
966
967
968
969
970
971
972
973
974
975
976
977
978

979
980
981
982
983
984
985
908
909
910
911
912
913
914

915
916
917
918
919
920
921

922
923
924
925
926
927
928

929
930
931
932
933
934
935

936
937
938
939
940
941
942
943
944
945
946
947
948
949

950
951
952
953
954
955
956
957
958
959
960
961
962
963

964
965
966
967
968
969
970
971
972
973
974
975
976
977

978
979
980
981
982
983
984
985







-
+






-
+






-
+






-
+













-
+













-
+













-
+








test regexp-23.1 {regexp -all and -line} {
    set string ""
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]
} {{{0 -1}} {{0 -1}} {{0 -1}}}
} {{{0 {}}} {{0 {}}} {{0 {}}}}
test regexp-23.2 {regexp -all and -line} {
    set string "\n"
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]
} {{{0 -1}} {{0 -1}} {{0 -1}}}
} {{{0 {}}} {{0 {}}} {{0 {}}}}
test regexp-23.3 {regexp -all and -line} {
    set string "\n\n"
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]
} {{{0 -1} {1 0}} {{0 -1} {1 0}} {{0 -1} {1 0}}}
} {{{0 {}} {1 0}} {{0 {}} {1 0}} {{0 {}} {1 0}}}
test regexp-23.4 {regexp -all and -line} {
    set string "a"
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^.*$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]
} {{{0 -1}} {{0 0}} {{1 0}}}
} {{{0 {}}} {{0 0}} {{1 0}}}
test regexp-23.5 {regexp -all and -line} {knownBug} {
    set string "a\n"
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^.*$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]
} {{{0 -1} {2 1}} {{0 0} {2 1}} {{1 0} {2 1}}}
test regexp-23.6 {regexp -all and -line} {
    set string "\na"
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^.*$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]
} {{{0 -1} {1 0}} {{0 -1} {1 1}} {{0 -1} {2 1}}}
} {{{0 {}} {1 0}} {{0 {}} {1 1}} {{0 {}} {2 1}}}
test regexp-23.7 {regexp -all and -line} {knownBug} {
    set string "ab\n"
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^.*$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]
} {{{0 -1} {3 2}} {{0 1} {3 2}} {{2 1} {3 2}}}
test regexp-23.8 {regexp -all and -line} {
    set string "a\nb"
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^.*$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]
} {{{0 -1} {2 1}} {{0 0} {2 2}} {{1 0} {3 2}}}
} {{{0 {}} {2 1}} {{0 0} {2 2}} {{1 0} {3 2}}}
test regexp-23.9 {regexp -all and -line} {knownBug} {
    set string "a\nb\n"
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^.*$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]
} {{{0 -1} {2 1} {4 3}} {{0 0} {2 2} {4 3}} {{1 0} {3 2} {4 3}}}
test regexp-23.10 {regexp -all and -line} {
    set string "a\nb\nc"
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^.*$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]
} {{{0 -1} {2 1} {4 3}} {{0 0} {2 2} {4 4}} {{1 0} {3 2} {5 4}}}
} {{{0 {}} {2 1} {4 3}} {{0 0} {2 2} {4 4}} {{1 0} {3 2} {5 4}}}
test regexp-23.11 {regexp -all and -line} {
    regexp -all -inline -indices -line -- {b} "abb\nb"
} {{1 1} {2 2} {4 4}}

test regexp-24.1 {regsub -all and -line} {
    foreach {v1 v2 v3} {{} {} {}} {}
    set string ""
Changes to tests/regexpComp.test.
224
225
226
227
228
229
230
231

232
233
234
235
236
237

238
239
240
241
242
243
244
224
225
226
227
228
229
230

231
232
233
234
235
236

237
238
239
240
241
242
243
244







-
+





-
+







    }
} {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}}
test regexpComp-3.6 {getting substrings back from regexp} {
    evalInProc {
	set foo 2; set f2 2; set f3 2; set f4 2
	list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
    }
} {1 {1 1} {1 1} {-1 -1} {-1 -1}}
} {1 {1 1} {1 1} {} {}}
test regexpComp-3.7 {getting substrings back from regexp} {
    evalInProc {
	set foo 1; set f2 1; set f3 1; set f4 1
	list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
    }
} {1 {1 2} {1 1} {-1 -1} {2 2}}
} {1 {1 2} {1 1} {} {2 2}}

test regexpComp-4.1 {-nocase option to regexp} {
    evalInProc {
	regexp -nocase foo abcFOo
    }
} 1
test regexpComp-4.2 {-nocase option to regexp} {
665
666
667
668
669
670
671
672

673
674
675
676
677
678
679
665
666
667
668
669
670
671

672
673
674
675
676
677
678
679







-
+







    exec [interpreter] $junk
} -cleanup {
    removeFile junk.tcl
} -result 1

test regexpComp-15.1 {regexp -start} -body {
    unset -nocomplain x
    list [regexp -start -10 {\d} 1abc2de3 x] $x
    list [regexp -start {} {\d} 1abc2de3 x] $x
} -result {1 1}
test regexpComp-15.2 {regexp -start} -body {
    unset -nocomplain x
    list [regexp -start 2 {\d} 1abc2de3 x] $x
} -result {1 2}
test regexpComp-15.3 {regexp -start} -body {
    unset -nocomplain x
693
694
695
696
697
698
699
700

701
702
703
704
705
706
707
693
694
695
696
697
698
699

700
701
702
703
704
705
706
707







-
+








test regexpComp-16.1 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} -result {4 a1b/2c/3d/4e/5}
test regexpComp-16.2 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start -25 {z} hello {/&} x] $x
    list [regsub -all -start {} {z} hello {/&} x] $x
} -result {0 hello}
test regexpComp-16.3 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start 3 {z} hello {/&} x] $x
} -result {0 hello}
test regexpComp-16.4 {regsub -start, \A behavior} -body {
    set out {}
780
781
782
783
784
785
786
787

788
789
790
791
792
793
794
780
781
782
783
784
785
786

787
788
789
790
791
792
793
794







-
+







	regexp -all -inline {^a} aaaa
    }
} {a}
test regexpComp-18.12 {regexp -all -inline -indices} {
    evalInProc {
	regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh
    }
} {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}}
} {{0 4} {1 3} {2 2} {} {5 9} {6 8} {} {7 7}}

test regexpComp-19.1 {regsub null replacement} {
    evalInProc {
	regsub -all {@} {@hel@lo@} "\0a\0" result
	list $result [string length $result]
    }
} "\0a\0hel\0a\0lo\0a\0 14"
Changes to tests/safe-stock.test.
153
154
155
156
157
158
159
160

161
162
163

164
165
166
167
168
169
170
153
154
155
156
157
158
159

160
161
162

163
164
165
166
167
168
169
170







-
+


-
+








# The following test checks whether the definition of tcl_endOfWord can be
# obtained from auto_loading.  It was previously test "safe-5.1".
test safe-stock-9.8 {test auto-loading in safe interpreters, was safe-5.1} -setup {
    catch {safe::interpDelete a}
    safe::interpCreate a
} -body {
    interp eval a {tcl_endOfWord "" 0}
    expr {[interp eval a {tcl_endOfWord "" 0}]<0}
} -cleanup {
    safe::interpDelete a
} -result -1
} -result 1
test safe-stock-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, uses pkg opt and tcl::idna} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $tcl_library $pkgOptDir] \
                                            [file join $tcl_library $pkgJarDir]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
Changes to tests/scan.test.
202
203
204
205
206
207
208
209
210


211
212
213
214


215
216
217
218
219
220
221
222


223
224
225
226
227
228
229
202
203
204
205
206
207
208


209
210
211
212


213
214
215
216
217
218
219
220


221
222
223
224
225
226
227
228
229







-
-
+
+


-
-
+
+






-
-
+
+







    list [scan {abc123456789012} {%3s%3d%3f%3[0-9]%s} a b c d e] $a $b $c $d $e
} {5 abc 123 456.0 789 012}
test scan-4.13 {Tcl_ScanObjCmd, width specifiers} {
    list [scan {abc123456789012} {%3s%3d%3f%3[0-9]%s} a b c d e] $a $b $c $d $e
} {5 abc 123 456.0 789 012}
test scan-4.14 {Tcl_ScanObjCmd, underflow} {
    set x {}
    list [scan {a} {a%d} x] $x
} {-1 {}}
    list [expr {[scan {a} {a%d} x]<0}] $x
} {1 {}}
test scan-4.15 {Tcl_ScanObjCmd, underflow} {
    set x {}
    list [scan {} {a%d} x] $x
} {-1 {}}
    list [expr {[scan {} {a%d} x]<0}] $x
} {1 {}}
test scan-4.16 {Tcl_ScanObjCmd, underflow} {
    set x {}
    list [scan {ab} {a%d} x] $x
} {0 {}}
test scan-4.17 {Tcl_ScanObjCmd, underflow} {
    set x {}
    list [scan {a   } {a%d} x] $x
} {-1 {}}
    list [expr {[scan {a   } {a%d} x]<0}] $x
} {1 {}}
test scan-4.18 {Tcl_ScanObjCmd, skipping whitespace} {
    list [scan {  b} {%c%s} x y] $x $y
} {2 32 b}
test scan-4.19 {Tcl_ScanObjCmd, skipping whitespace} {
    list [scan {  b} {%[^b]%s} x y] $x $y
} {2 {  } b}
test scan-4.20 {Tcl_ScanObjCmd, string scanning} {
344
345
346
347
348
349
350
351
352


353
354
355
356
357
358
359
344
345
346
347
348
349
350


351
352
353
354
355
356
357
358
359







-
-
+
+







    set x {}
} -body {
    list [scan {+ } {%i} x] $x
} -result {0 {}}
test scan-4.44 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup {
    set x {}
} -body {
    list [scan {+} {%i} x] $x
} -result {-1 {}}
    list [expr {[scan {+} {%i} x]<0}] $x
} -result {1 {}}
test scan-4.45 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup {
    set x {}
} -body {
    list [scan {0x} {%i%s} x y] $x $y
} -result {2 0 x}
test scan-4.46 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup {
    set x {}
391
392
393
394
395
396
397
398
399


400
401
402
403
404
405
406
391
392
393
394
395
396
397


398
399
400
401
402
403
404
405
406







-
-
+
+







} {1 10.0}
test scan-4.54 {Tcl_ScanObjCmd, float scanning} {
    list [scan {1.0e-1} %f x] $x
} {1 0.1}
test scan-4.55 {Tcl_ScanObjCmd, odd cases} -setup {
    set x {}
} -body {
    list [scan {+} %f x] $x
} -result {-1 {}}
    list [expr {[scan {+} %f x]<0}] $x
} -result {1 {}}
test scan-4.56 {Tcl_ScanObjCmd, odd cases} -setup {
    set x {}
} -body {
    list [scan {1.0e} %f%s x y] $x $y
} -result {2 1.0 e}
test scan-4.57 {Tcl_ScanObjCmd, odd cases} -setup {
    set x {}
Changes to tests/string.test.
385
386
387
388
389
390
391
392
393


394
395
396
397
398
399
400
401
402
403
404
405


406
407
408
409
410

411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428


429
430

431
432
433
434
435
436
437
438
439
440
441
442
443





444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461

462
463
464
465
466
467
468
385
386
387
388
389
390
391


392
393
394
395
396
397
398
399
400
401
402
403


404
405
406
407
408
409

410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426


427
428
429

430
431
432
433
434
435
436
437
438





439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460

461
462
463
464
465
466
467
468







-
-
+
+










-
-
+
+




-
+
















-
-
+
+

-
+








-
-
-
-
-
+
+
+
+
+

















-
+







test string-4.6.$noComp {string first} {
    run {string f b abcdefgbcefgbqrs}
} 1
test string-4.7.$noComp {string first} {
    run {string first xxx x123xx345xxx789xxx012}
} 9
test string-4.8.$noComp {string first} {
    run {string first "" x123xx345xxx789xxx012}
} -1
    run {expr {[string first "" x123xx345xxx789xxx012]<0}}
} 1
test string-4.9.$noComp {string first, unicode} {
    run {string first x abc牦x}
} 4
test string-4.10.$noComp {string first, unicode} {
    run {string first 牦 abc牦x}
} 3
test string-4.11.$noComp {string first, start index} {
    run {string first 牦 abc牦x 3}
} 3
test string-4.12.$noComp {string first, start index} -body {
    run {string first 牦 abc牦x 4}
} -result -1
    run {expr {[string first 牦 abc牦x 4]<0}}
} -result 1
test string-4.13.$noComp {string first, start index} -body {
    run {string first 牦 abc牦x end-2}
} -result 3
test string-4.14.$noComp {string first, negative start index} -body {
    run {string first b abc -1}
    run {string first b abc {}}
} -result 1
test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} -body {
    # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded
    # strings was incorrect, leading to an index returned by [string first]
    # which pointed past the end of the string.
    set uchar Õ¾    ;# character with two-byte encoding in utf-8
    run {string first % %#$uchar$uchar#$uchar$uchar#% 3}
} -result 8
test string-4.16.$noComp {string first, normal string vs pure unicode string} -body {
    set s hello
    regexp ll $s m
    # Representation checks are canaries
    run {list [representationpoke $s] [representationpoke $m] \
	[string first $m $s]}
} -result {{string 1} {string 0} 2}
test string-4.17.$noComp {string first, corner case} -body {
    run {string first a aaa 4294967295}
} -result {-1}
    run {expr {[string first a aaa 4294967295]<0}}
} -result 1
test string-4.18.$noComp {string first, corner case} -body {
    run {string first a aaa -1}
    run {string first a aaa {}}
} -result {0}
test string-4.19.$noComp {string first, corner case} -body {
    run {string first a aaa end-5}
} -result {0}
test string-4.20.$noComp {string last, corner case} -body {
    run {string last a aaa 4294967295}
} -result {2}
test string-4.21.$noComp {string last, corner case} -body {
    run {string last a aaa -1}
} -result {-1}
test string-4.22.$noComp {string last, corner case} {
    run {string last a aaa end-5}
} {-1}
    run {expr {[string last a aaa {}]<0}}
} -result 1
test string-4.22.$noComp {string last, corner case} -body {
    run {expr {[string last a aaa end-5]<0}}
} -result 1

test string-5.1.$noComp {string index} {
    list [catch {run {string index}} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
test string-5.2.$noComp {string index} {
    list [catch {run {string index a b c}} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
test string-5.3.$noComp {string index} {
    run {string index abcde 0}
} a
test string-5.4.$noComp {string index} {
    run {string ind abcde 4}
} e
test string-5.5.$noComp {string index} {
    run {string index abcde 5}
} {}
test string-5.6.$noComp {string index} {
    list [catch {run {string index abcde -10}} msg] $msg
    list [catch {run {string index abcde {}}} msg] $msg
} {0 {}}
test string-5.7.$noComp {string index} {
    list [catch {run {string index a xyz}} msg] $msg
} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}}
test string-5.8.$noComp {string index} {
    run {string index abc end}
} c
498
499
500
501
502
503
504
505

506
507
508
509
510
511
512
498
499
500
501
502
503
504

505
506
507
508
509
510
511
512







-
+







test string-5.17.$noComp {string index, bad integer} -body {
    list [catch {run {string index "abc" 0o8}} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test string-5.18.$noComp {string index, bad integer} -body {
    list [catch {run {string index "abc" end-0o0289}} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test string-5.19.$noComp {string index, bytearray object out of bounds} {
    run {string index [binary format I* {0x50515253 0x52}] -1}
    run {string index [binary format I* {0x50515253 0x52}] {}}
} {}
test string-5.20.$noComp {string index, bytearray object out of bounds} -body {
    run {string index [binary format I* {0x50515253 0x52}] 20}
} -result {}
test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints utf16 -body {
    run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]}
} -result [list \U100000 {} b]
852
853
854
855
856
857
858
859
860


861
862
863
864
865
866
867
852
853
854
855
856
857
858


859
860
861
862
863
864
865
866
867







-
-
+
+







test string-6.100.$noComp {string is wideinteger, true with whitespace} {
    run {string is wideinteger "  \n1234\v"}
} 1
test string-6.101.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var 123abc}] $var
} {0 3}
test string-6.102.$noComp {string is wideinteger, false on overflow} {
    list [run {string is wideinteger -fail var +9223372036854775808}] $var
} {0 -1}
    list [run {string is wideinteger -fail var +9223372036854775808}] [expr {$var<0}]
} {0 1}
test string-6.103.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var [expr {double(1)}]}] $var
} {0 1}
test string-6.104.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var "    "}] $var
} {0 0}
test string-6.105.$noComp {string is wideinteger, false on bad octal} {
1015
1016
1017
1018
1019
1020
1021
1022
1023


1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034


1035
1036
1037
1038
1039
1040
1041
1015
1016
1017
1018
1019
1020
1021


1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032


1033
1034
1035
1036
1037
1038
1039
1040
1041







-
-
+
+









-
-
+
+







test string-7.10.$noComp {string last, unicode} {
    run {string las 牦 xxxx12牦xx345x678}
} 6
test string-7.11.$noComp {string last, start index} {
    run {string last 牦 abc牦x 3}
} 3
test string-7.12.$noComp {string last, start index} {
    run {string last 牦 abc牦x 2}
} -1
    run {expr {[string last 牦 abc牦x 2]<0}}
} 1
test string-7.13.$noComp {string last, start index} {
    ## Constrain to last 'a' should work
    run {string last ba badbad end-1}
} 3
test string-7.14.$noComp {string last, start index} {
    ## Constrain to last 'b' should skip last 'ba'
    run {string last ba badbad end-2}
} 0
test string-7.15.$noComp {string last, start index} {
    run {string last Üa ÜadÜad 0}
} -1
    run {expr {[string last Üa ÜadÜad 0]<0}}
} 1
test string-7.16.$noComp {string last, start index} {
    run {string last Üa ÜadÜad end-1}
} 3

test string-8.1.$noComp {string bytelength} deprecated {
    list [catch {run {string bytelength}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
1449
1450
1451
1452
1453
1454
1455
1456

1457
1458
1459

1460
1461
1462
1463
1464
1465

1466
1467
1468
1469
1470
1471
1472
1449
1450
1451
1452
1453
1454
1455

1456
1457
1458

1459
1460
1461
1462
1463
1464

1465
1466
1467
1468
1469
1470
1471
1472







-
+


-
+





-
+







test string-12.6.$noComp {string range} {
    run {string range abcdefghijklmnop 10 end}
} {klmnop}
test string-12.7.$noComp {string range, last < first} {
    run {string range abcdefghijklmnop 10 9}
} {}
test string-12.8.$noComp {string range, first < 0} {
    run {string range abcdefghijklmnop -3 2}
    run {string range abcdefghijklmnop {} 2}
} {abc}
test string-12.9.$noComp {string range} {
    run {string range abcdefghijklmnop -3 -2}
    run {string range abcdefghijklmnop {} {}}
} {}
test string-12.10.$noComp {string range} {
    run {string range abcdefghijklmnop 1000 1010}
} {}
test string-12.11.$noComp {string range} {
    run {string range abcdefghijklmnop -100 end}
    run {string range abcdefghijklmnop {} end}
} {abcdefghijklmnop}
test string-12.12.$noComp {string range} {
    list [catch {run {string range abc abc 1}} msg] $msg
} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
test string-12.13.$noComp {string range} {
    list [catch {run {string range abc 1 eof}} msg] $msg
} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
1597
1598
1599
1600
1601
1602
1603
1604

1605
1606
1607

1608
1609
1610
1611
1612
1613

1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634

1635
1636
1637
1638
1639
1640
1641
1597
1598
1599
1600
1601
1602
1603

1604
1605
1606

1607
1608
1609
1610
1611
1612

1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633

1634
1635
1636
1637
1638
1639
1640
1641







-
+


-
+





-
+




















-
+







test string-14.7.$noComp {string replace} {
    run {string replace abcdefghijklmnop 10 end}
} {abcdefghij}
test string-14.8.$noComp {string replace} {
    run {string replace abcdefghijklmnop 10 9}
} {abcdefghijklmnop}
test string-14.9.$noComp {string replace} {
    run {string replace abcdefghijklmnop -3 2}
    run {string replace abcdefghijklmnop {} 2}
} {defghijklmnop}
test string-14.10.$noComp {string replace} {
    run {string replace abcdefghijklmnop -3 -2}
    run {string replace abcdefghijklmnop {} {}}
} {abcdefghijklmnop}
test string-14.11.$noComp {string replace} -body {
    run {string replace abcdefghijklmnop 1000 1010}
} -result {abcdefghijklmnop}
test string-14.12.$noComp {string replace} {
    run {string replace abcdefghijklmnop -100 end}
    run {string replace abcdefghijklmnop {} end}
} {}
test string-14.13.$noComp {string replace} {
    list [catch {run {string replace abc abc 1}} msg] $msg
} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
test string-14.14.$noComp {string replace} {
    list [catch {run {string replace abc 1 eof}} msg] $msg
} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
test string-14.15.$noComp {string replace} {
    run {string replace abcdefghijklmnop end-10 end-2 NEW}
} {abcdeNEWop}
test string-14.16.$noComp {string replace} {
    run {string replace abcdefghijklmnop 0 end foo}
} {foo}
test string-14.17.$noComp {string replace} {
    run {string replace abcdefghijklmnop end end-1}
} {abcdefghijklmnop}
test string-14.18.$noComp {string replace} {
    run {string replace abcdefghijklmnop 10 9 XXX}
} {abcdefghijklmnop}
test string-14.19.$noComp {string replace} {
    run {string replace {} -1 0 A}
    run {string replace {} {} 0 A}
} A
test string-14.20.$noComp {string replace} {
    run {string replace [makeByteArray abcdefghijklmnop] end-10 end-2\
	    [makeByteArray NEW]}
} {abcdeNEWop}
test string-14.21.$noComp {string replace (surrogates)} {
    run {string replace \uD83D? 1 end \uDE02}
1890
1891
1892
1893
1894
1895
1896
1897

1898
1899
1900
1901
1902
1903
1904
1890
1891
1892
1893
1894
1895
1896

1897
1898
1899
1900
1901
1902
1903
1904







-
+







test string-21.2.$noComp {string wordend} -body {
    list [catch {run {string wordend a b c}} msg] $msg
} -result {1 {wrong # args: should be "string wordend string index"}}
test string-21.3.$noComp {string wordend} -body {
    list [catch {run {string wordend a gorp}} msg] $msg
} -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
test string-21.4.$noComp {string wordend} -body {
    run {string wordend abc. -1}
    run {string wordend abc. {}}
} -result 3
test string-21.5.$noComp {string wordend} -body {
    run {string wordend abc. 100}
} -result 4
test string-21.6.$noComp {string wordend} -body {
    run {string wordend "word_one two three" 2}
} -result 8
1975
1976
1977
1978
1979
1980
1981
1982

1983
1984
1985
1986
1987
1988
1989
1975
1976
1977
1978
1979
1980
1981

1982
1983
1984
1985
1986
1987
1988
1989







-
+







test string-22.5.$noComp {string wordstart} -body {
    run {string wordstart "one two three_words" 400}
} -result 8
test string-22.6.$noComp {string wordstart} -body {
    run {string wordstart "one two three_words" 2}
} -result 0
test string-22.7.$noComp {string wordstart} -body {
    run {string wordstart "one two three_words" -2}
    run {string wordstart "one two three_words" {}}
} -result 0
test string-22.8.$noComp {string wordstart} -body {
    run {string wordstart "one .*&^ three" 6}
} -result 6
test string-22.9.$noComp {string wordstart} -body {
    run {string wordstart "one two three" 4}
} -result 4
2491
2492
2493
2494
2495
2496
2497
2498

2499
2500
2501
2502
2503
2504
2505
2491
2492
2493
2494
2495
2496
2497

2498
2499
2500
2501
2502
2503
2504
2505







-
+







test string-31.8.$noComp {string insert, empty insert string} {
    run {tcl::string::insert 0123 0 {}}
} 0123
test string-31.9.$noComp {string insert, empty strings} {
    run {tcl::string::insert {} 0 {}}
} {}
test string-31.10.$noComp {string insert, negative index} {
    run {tcl::string::insert 0123 -1 _}
    run {tcl::string::insert 0123 {} _}
} _0123
test string-31.11.$noComp {string insert, index beyond end} {
    run {tcl::string::insert 0123 5 _}
} 0123_
test string-31.12.$noComp {string insert, start of string, pure byte array} {
    run {tcl::string::insert [makeByteArray 0123] 0 [makeByteArray _]}
} _0123
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594



2595
2596
2597
2598
2599
2600
2601
2585
2586
2587
2588
2589
2590
2591



2592
2593
2594
2595
2596
2597
2598
2599
2600
2601







-
-
-
+
+
+







    string is dict -strict {}
} 1
test string-32.9.$noComp {string is dict} {
    set x {}
    list [string is dict -failindex x {a b c d}] $x
} {1 {}}
test string-32.9a.$noComp {string is dict} {
    set x {}
    list [string is dict -failindex x {a b c}] $x
} {0 -1}
    set x 0
    list [string is dict -failindex x {a b c}] [expr {$x<0}]
} {0 1}
test string-32.10.$noComp {string is dict} {
    set x {}
    list [string is dict -failindex x "a \{b c d"] $x
} {0 2}
test string-32.10a.$noComp {string is dict} {
    set x {}
    list [string is dict -failindex x "a \{b c"] $x
Changes to tests/switch.test.
565
566
567
568
569
570
571
572

573
574
575
576
577
578
579
565
566
567
568
569
570
571

572
573
574
575
576
577
578
579







-
+







    switch -regexp -indexvar x -- $str ^... {string range $str {*}[lindex $x 0]}
} abc
test switch-12.8 {-indexvar and matched empty strings} {
    switch -regexp -indexvar x -- abcdef ^...(x?) {return $x}
} {{0 2} {3 2}}
test switch-12.9 {-indexvar and unmatched strings} {
    switch -regexp -indexvar x -- abcdef ^...(x)? {return $x}
} {{0 2} {-1 -1}}
} {{0 2} {}}

test switch-13.1 {-indexvar -matchvar combinations} {
    switch -regexp -indexvar x -matchvar y abc {
	. {list $x $y}
    }
} {{{0 0}} a}
test switch-13.2 {-indexvar -matchvar combinations} {
Changes to tests/util.test.
581
582
583
584
585
586
587
588

589
590
591
592
593
594
595
581
582
583
584
585
586
587

588
589
590
591
592
593
594
595







-
+







test util-9.0.0 {Tcl_GetIntForIndex} {
    string index abcd 0
} a
test util-9.0.1 {Tcl_GetIntForIndex} {
    string index abcd 0x0
} a
test util-9.0.2 {Tcl_GetIntForIndex} {
    string index abcd -0x0
    string index abcd 0x0
} a
test util-9.0.3 {Tcl_GetIntForIndex} {
    string index abcd { 0 }
} a
test util-9.0.4 {Tcl_GetIntForIndex} {
    string index abcd { 0x0 }
} a
679
680
681
682
683
684
685
686

687
688
689

690
691
692
693
694
695
696
697
698
699

700
701
702
703
704
705
706
679
680
681
682
683
684
685

686
687
688

689
690
691
692
693
694
695
696
697
698

699
700
701
702
703
704
705
706







-
+


-
+









-
+







test util-9.13 {Tcl_GetIntForIndex} {
    string index abcd 1+1
} c
test util-9.14 {Tcl_GetIntForIndex} {
    string index abcd 1-1
} a
test util-9.15 {Tcl_GetIntForIndex} {
    string index abcd -1+2
    string index abcd 2+-1
} b
test util-9.16 {Tcl_GetIntForIndex} {
    string index abcd -1--2
    string index abcd 1--0
} b
test util-9.17 {Tcl_GetIntForIndex} {
    string index abcd { -1+2 }
} b
test util-9.18 {Tcl_GetIntForIndex} {
    string index abcd { -1--2 }
} b
test util-9.19 {Tcl_GetIntForIndex} -body {
    string index a {}
} -returnCodes error -match glob -result *
} -result {}
test util-9.20 {Tcl_GetIntForIndex} -body {
    string index a { }
} -returnCodes error -match glob -result *
test util-9.21 {Tcl_GetIntForIndex} -body {
    string index a " \r\t\n"
} -returnCodes error -match glob -result *
test util-9.22 {Tcl_GetIntForIndex} -body {
785
786
787
788
789
790
791
792

793
794
795
796
797
798
799
785
786
787
788
789
790
791

792
793
794
795
796
797
798
799







-
+







    string index abcd end+4294967294
} -result {}
# TIP 502
test util-9.47 {Tcl_GetIntForIndex} -body {
    string index abcd 0x10000000000000000
} -result {}
test util-9.48 {Tcl_GetIntForIndex} {
    string index abcd -0x10000000000000000
    string index abcd 0x10000000000000000
} {}
test util-9.49 {Tcl_GetIntForIndex} -body {
    string index abcd end*1
} -returnCodes error -match glob -result *
test util-9.50 {Tcl_GetIntForIndex} -body {
    string index abcd {end- 1}
} -returnCodes error -match glob -result *