Changes On Branch tip-660-with-trunk-testcases
Not logged in

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

Changes In Branch tip-660-with-trunk-testcases Excluding Merge-Ins

This is equivalent to a diff from 0a224d1449 to ae89fcb5d3

2023-04-19
02:00
Merge trunk check-in: 5ad7c7b96d user: apnadkarni tags: tip-660
2023-04-18
21:38
TIP #660, merge trunk, replace testscases with trunk testcases Closed-Leaf check-in: ae89fcb5d3 user: jan.nijtmans tags: tip-660-with-trunk-testcases
21:16
Eliminate unnecessary clearance of CHANNEL_STICKY_EOF flag. check-in: af256f4469 user: pooryorick tags: trunk, main
02:55
Merge trunk check-in: 0a224d1449 user: apnadkarni tags: tip-660
2023-04-17
22:01
Make encoding profile explicit in some tests. check-in: 5995ca9b6c user: pooryorick tags: trunk, main
2023-04-16
17:05
Update manpages for TIP 660. Also one size_t -> Tcl_Size change in public API check-in: d2681fe90d user: apnadkarni tags: tip-660

Changes to generic/tcl.h.
311
312
313
314
315
316
317

318
319
320
321
322
323
324
#	define TCL_T_MODIFIER	"t"
#   elif defined(_WIN64)
#	define TCL_T_MODIFIER	TCL_LL_MODIFIER
#   else
#	define TCL_T_MODIFIER	TCL_Z_MODIFIER
#   endif
#endif /* !TCL_T_MODIFIER */

#define Tcl_WideAsLong(val)	((long)((Tcl_WideInt)(val)))
#define Tcl_LongAsWide(val)	((Tcl_WideInt)((long)(val)))
#define Tcl_WideAsDouble(val)	((double)((Tcl_WideInt)(val)))
#define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))

#if TCL_MAJOR_VERSION < 9
    typedef int Tcl_Size;







>







311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
#	define TCL_T_MODIFIER	"t"
#   elif defined(_WIN64)
#	define TCL_T_MODIFIER	TCL_LL_MODIFIER
#   else
#	define TCL_T_MODIFIER	TCL_Z_MODIFIER
#   endif
#endif /* !TCL_T_MODIFIER */

#define Tcl_WideAsLong(val)	((long)((Tcl_WideInt)(val)))
#define Tcl_LongAsWide(val)	((Tcl_WideInt)((long)(val)))
#define Tcl_WideAsDouble(val)	((double)((Tcl_WideInt)(val)))
#define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))

#if TCL_MAJOR_VERSION < 9
    typedef int Tcl_Size;
459
460
461
462
463
464
465
466
467

468
469
470
471




472
473
474
475
476
477

478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497

498
499
500
501
502
503
504

/*
 * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
 * relative to the start of the match string, not the beginning of the entire
 * string.
 */

#if TCL_MAJOR_VERSION > 8
typedef struct Tcl_RegExpIndices {

    Tcl_Size start;			/* Character offset of first character in
				 * match. */
    Tcl_Size end;			/* Character offset of first character after
				 * the match. */




} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    Tcl_Size nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */

    Tcl_Size extendStart;		/* The offset at which a subsequent match
				 * might begin. */
} Tcl_RegExpInfo;
#else
typedef struct Tcl_RegExpIndices {
    long start;			/* Character offset of first character in
				 * match. */
    long end;			/* Character offset of first character after
				 * the match. */
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    int nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
    long extendStart;		/* The offset at which a subsequent match
				 * might begin. */
    long reserved;		/* Reserved for later use. */
} Tcl_RegExpInfo;
#endif


/*
 * Picky compilers complain if this typdef doesn't appear before the struct's
 * reference in tclDecls.h.
 */

typedef Tcl_StatBuf *Tcl_Stat_;







<

>




>
>
>
>






>


<

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

<

>







460
461
462
463
464
465
466

467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485

486











487

488

489
490
491
492
493
494
495
496
497

/*
 * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
 * relative to the start of the match string, not the beginning of the entire
 * string.
 */


typedef struct Tcl_RegExpIndices {
#if TCL_MAJOR_VERSION > 8
    Tcl_Size start;			/* Character offset of first character in
				 * match. */
    Tcl_Size end;			/* Character offset of first character after
				 * the match. */
#else
    long start;
    long end;
#endif
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    Tcl_Size nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
#if TCL_MAJOR_VERSION > 8
    Tcl_Size extendStart;		/* The offset at which a subsequent match
				 * might begin. */

#else











    long extendStart;

    long reserved;		/* Reserved for later use. */

#endif
} Tcl_RegExpInfo;

/*
 * Picky compilers complain if this typdef doesn't appear before the struct's
 * reference in tclDecls.h.
 */

typedef Tcl_StatBuf *Tcl_Stat_;
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
 *				is described by a TCL_TOKEN_SUB_EXPR token
 *				followed by the TCL_TOKEN_OPERATOR token for
 *				the operator, then TCL_TOKEN_SUB_EXPR tokens
 *				for the left then the right operands.
 * TCL_TOKEN_OPERATOR -		The token describes one expression operator.
 *				An operator might be the name of a math
 *				function such as "abs". A TCL_TOKEN_OPERATOR
 *				token is always preceeded by one
 *				TCL_TOKEN_SUB_EXPR token for the operator's
 *				subexpression, and is followed by zero or more
 *				TCL_TOKEN_SUB_EXPR tokens for the operator's
 *				operands. NumComponents is always 0.
 * TCL_TOKEN_EXPAND_WORD -	This token is just like TCL_TOKEN_WORD except
 *				that it marks a word that began with the
 *				literal character prefix "{*}". This word is







|







1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
 *				is described by a TCL_TOKEN_SUB_EXPR token
 *				followed by the TCL_TOKEN_OPERATOR token for
 *				the operator, then TCL_TOKEN_SUB_EXPR tokens
 *				for the left then the right operands.
 * TCL_TOKEN_OPERATOR -		The token describes one expression operator.
 *				An operator might be the name of a math
 *				function such as "abs". A TCL_TOKEN_OPERATOR
 *				token is always preceded by one
 *				TCL_TOKEN_SUB_EXPR token for the operator's
 *				subexpression, and is followed by zero or more
 *				TCL_TOKEN_SUB_EXPR tokens for the operator's
 *				operands. NumComponents is always 0.
 * TCL_TOKEN_EXPAND_WORD -	This token is just like TCL_TOKEN_WORD except
 *				that it marks a word that began with the
 *				literal character prefix "{*}". This word is
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
 * (or perhaps 1 if we want to support a non-unicode enabled core). If > 3,
 * then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3,
 * then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
 * mode is the default and recommended mode.
 */

#ifndef TCL_UTF_MAX
#if TCL_MAJOR_VERSION > 8
#define TCL_UTF_MAX		4
#else
#define TCL_UTF_MAX		3
#endif
#endif

/*
 * This represents a Unicode character. Any changes to this should also be
 * reflected in regcustom.h.
 */








|
|
|
|
|







2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
 * (or perhaps 1 if we want to support a non-unicode enabled core). If > 3,
 * then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3,
 * then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
 * mode is the default and recommended mode.
 */

#ifndef TCL_UTF_MAX
#   if TCL_MAJOR_VERSION > 8
#	define TCL_UTF_MAX		4
#   else
#	define TCL_UTF_MAX		3
#   endif
#endif

/*
 * This represents a Unicode character. Any changes to this should also be
 * reflected in regcustom.h.
 */

Changes to generic/tclIO.c.
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
    Tcl_Size oldLength;
    Tcl_Encoding encoding;
    char *dst, *dstEnd, *eol, *eof;
    Tcl_EncodingState oldState;

    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
	UpdateInterest(chanPtr);
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED);
	Tcl_SetErrno(EILSEQ);
	return TCL_INDEX_NONE;
    }

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	return TCL_INDEX_NONE;
    }







|







4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
    Tcl_Size oldLength;
    Tcl_Encoding encoding;
    char *dst, *dstEnd, *eol, *eof;
    Tcl_EncodingState oldState;

    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
	UpdateInterest(chanPtr);
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
	Tcl_SetErrno(EILSEQ);
	return TCL_INDEX_NONE;
    }

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	return TCL_INDEX_NONE;
    }
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
    int result;
    Tcl_Encoding encoding = statePtr->encoding;
    int binaryMode;
#define UTF_EXPANSION_FACTOR	1024
    int factor = UTF_EXPANSION_FACTOR;

    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
	/* TODO: We don't need this call? */
	UpdateInterest(chanPtr);
	Tcl_SetErrno(EILSEQ);
	return -1;
    }
    /*
     * Early out when next read will see eofchar.







|







5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
    int result;
    Tcl_Encoding encoding = statePtr->encoding;
    int binaryMode;
#define UTF_EXPANSION_FACTOR	1024
    int factor = UTF_EXPANSION_FACTOR;

    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED);
	/* TODO: We don't need this call? */
	UpdateInterest(chanPtr);
	Tcl_SetErrno(EILSEQ);
	return -1;
    }
    /*
     * Early out when next read will see eofchar.
Changes to tests/indexObj.test.
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

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

testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testgetintforindex [llength [info commands testgetintforindex]]
testConstraint testparseargs [llength [info commands testparseargs]]
testConstraint has64BitLengths [expr {$tcl_platform(pointerSize) == 8}]

test indexObj-1.1 {exact match} testindexobj {
    testindexobj 1 1 xyz abc def xyz alm
} {2}
test indexObj-1.2 {exact match} testindexobj {
    testindexobj 1 1 abc abc def xyz alm
} {0}







<







15
16
17
18
19
20
21

22
23
24
25
26
27
28

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

testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testgetintforindex [llength [info commands testgetintforindex]]
testConstraint testparseargs [llength [info commands testparseargs]]


test indexObj-1.1 {exact match} testindexobj {
    testindexobj 1 1 xyz abc def xyz alm
} {2}
test indexObj-1.2 {exact match} testindexobj {
    testindexobj 1 1 abc abc def xyz alm
} {0}
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
    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
} [expr {[testConstraint has64BitLengths] ? 2147483648 : 2147483647}]
test indexObj-8.6 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 2147483646
} 2147483645
test indexObj-8.7 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 2147483647
} 2147483646
test indexObj-8.8 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end 2147483646
} 2147483646
test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end 2147483647
} 2147483647
test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -1
} -1
test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -2
} -1
test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -1
} -1
test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -2
} -1
test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -1
} 0
test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -2
} -1








|














|


|





|







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
    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
} 2147483648
test indexObj-8.6 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 2147483646
} 2147483645
test indexObj-8.7 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 2147483647
} 2147483646
test indexObj-8.8 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end 2147483646
} 2147483646
test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end 2147483647
} 2147483647
test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -1
} -2
test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -2
} -3
test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -1
} -1
test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -2
} -2
test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -1
} 0
test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -2
} -1

Changes to tests/interp.test.
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
    list $result $msg
} {1 {expected integer but got "bar"}}
test interp-29.1.5 {interp recursionlimit argument checking} -body {
    interp create moo
    set result [catch {interp recursionlimit moo 0} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0}}
test interp-29.1.6 {interp recursionlimit argument checking} -body {
    interp create moo
    set result [catch {interp recursionlimit moo -1} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0}}
test interp-29.1.7 {interp recursionlimit argument checking} {
    interp create moo
    set result [catch {interp recursionlimit moo [expr {wide(1)<<64}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
test interp-29.1.8 {child recursionlimit argument checking} {







|





|







2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
    list $result $msg
} {1 {expected integer but got "bar"}}
test interp-29.1.5 {interp recursionlimit argument checking} -body {
    interp create moo
    set result [catch {interp recursionlimit moo 0} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0 and < *}}
test interp-29.1.6 {interp recursionlimit argument checking} -body {
    interp create moo
    set result [catch {interp recursionlimit moo -1} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0 and < *}}
test interp-29.1.7 {interp recursionlimit argument checking} {
    interp create moo
    set result [catch {interp recursionlimit moo [expr {wide(1)<<64}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
test interp-29.1.8 {child recursionlimit argument checking} {
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
    list $result $msg
} {1 {expected integer but got "foo"}}
test interp-29.1.10 {child recursionlimit argument checking} -body {
    interp create moo
    set result [catch {moo recursionlimit 0} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0}}
test interp-29.1.11 {child recursionlimit argument checking} -body {
    interp create moo
    set result [catch {moo recursionlimit -1} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0}}
test interp-29.1.12 {child recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit [expr {wide(1)<<64}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
test interp-29.2.1 {query recursion limit} {







|





|







2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
    list $result $msg
} {1 {expected integer but got "foo"}}
test interp-29.1.10 {child recursionlimit argument checking} -body {
    interp create moo
    set result [catch {moo recursionlimit 0} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0 and < *}}
test interp-29.1.11 {child recursionlimit argument checking} -body {
    interp create moo
    set result [catch {moo recursionlimit -1} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0 and < *}}
test interp-29.1.12 {child recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit [expr {wide(1)<<64}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
test interp-29.2.1 {query recursion limit} {
Changes to tests/io.test.
9476
9477
9478
9479
9480
9481
9482
9483
9484
9485
9486
9487
9488
9489
9490
    set chan [file tempfile]
    fconfigure $chan -encoding binary
    # \xc0\n is an invalid utf-8 sequence
    puts -nonewline $chan a\nb\nc\xc0\nd\n
    flush $chan
    seek $chan 0
    fconfigure $chan -encoding utf-8 -buffering none -eofchar {} \
	-translation lf -profile strict
} -body {
    lappend res [gets $chan]
    lappend res [gets $chan]
    set status [catch {gets $chan} cres copts]
    lappend res $status $cres
    chan configure $chan -profile tcl8 
    lappend res [gets $chan]







|







9476
9477
9478
9479
9480
9481
9482
9483
9484
9485
9486
9487
9488
9489
9490
    set chan [file tempfile]
    fconfigure $chan -encoding binary
    # \xc0\n is an invalid utf-8 sequence
    puts -nonewline $chan a\nb\nc\xc0\nd\n
    flush $chan
    seek $chan 0
    fconfigure $chan -encoding utf-8 -buffering none -eofchar {} \
	-translation auto -profile strict
} -body {
    lappend res [gets $chan]
    lappend res [gets $chan]
    set status [catch {gets $chan} cres copts]
    lappend res $status $cres
    chan configure $chan -profile tcl8 
    lappend res [gets $chan]
9516
9517
9518
9519
9520
9521
9522
9523
9524
9525
9526
9527
9528
9529
9530
    lappend res $status $cres
	chan configure $chan -translation binary
	set data [read $chan 4]
	foreach char [split $data {}] {
		scan $char %c ord
		lappend res [format %x $ord]
	}
    fconfigure $chan -encoding utf-8 -profile strict
	lappend res [gets $chan]
	lappend res [gets $chan]
    return $res
} -cleanup {
    close $chan
} -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\
    1 {error reading "*": invalid or incomplete multibyte or wide character} 43 44 c0 40 EF GHI}







|







9516
9517
9518
9519
9520
9521
9522
9523
9524
9525
9526
9527
9528
9529
9530
    lappend res $status $cres
	chan configure $chan -translation binary
	set data [read $chan 4]
	foreach char [split $data {}] {
		scan $char %c ord
		lappend res [format %x $ord]
	}
    fconfigure $chan -encoding utf-8 -profile strict -translation auto
	lappend res [gets $chan]
	lappend res [gets $chan]
    return $res
} -cleanup {
    close $chan
} -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\
    1 {error reading "*": invalid or incomplete multibyte or wide character} 43 44 c0 40 EF GHI}
Changes to tests/listObj.test.
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

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

testConstraint testobj [llength [info commands testobj]]
testConstraint memory [llength [info commands memory]]

set INT_MAX 0x7fffffff; # Assumes sizeof(int) == 4
set SIZE_MAX [expr {(1 << (8*$::tcl_platform(pointerSize) - 1)) - 1}]

catch {unset x}
test listobj-1.1 {Tcl_GetListObjType} emptyTest {
    # Test removed; tested an internal detail
    # that's no longer correct, and duplicated test obj-1.1
} {}

test listobj-2.1 {Tcl_SetListObj, use in lappend} {







<
<
<







18
19
20
21
22
23
24



25
26
27
28
29
30
31

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

testConstraint testobj [llength [info commands testobj]]
testConstraint memory [llength [info commands memory]]




catch {unset x}
test listobj-1.1 {Tcl_GetListObjType} emptyTest {
    # Test removed; tested an internal detail
    # that's no longer correct, and duplicated test obj-1.1
} {}

test listobj-2.1 {Tcl_SetListObj, use in lappend} {
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
    testlistobj get 1
} {f c d e}
test listobj-10.3 {Tcl_ListObjReplace with negative count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 -1 f
    testlistobj get 1
} {a f b c d e}
test listobj-10.4 {Tcl_ListObjReplace with $SIZE_MAX count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 $SIZE_MAX f
    testlistobj get 1
} {a f}
test listobj-10.5 {Tcl_ListObjReplace with SIZE_MAX-1 count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 [expr {$SIZE_MAX -1}] f
    testlistobj get 1
} {a f}

test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj {
    testobj bug3598580
} 123








|

|




|







202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
    testlistobj get 1
} {f c d e}
test listobj-10.3 {Tcl_ListObjReplace with negative count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 -1 f
    testlistobj get 1
} {a f b c d e}
test listobj-10.4 {Tcl_ListObjReplace with UINT_MAX-1 count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 0xFFFFFFFE f
    testlistobj get 1
} {a f}
test listobj-10.5 {Tcl_ListObjReplace with SIZE_MAX-1 count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 -2 f
    testlistobj get 1
} {a f}

test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj {
    testobj bug3598580
} 123

Changes to tests/lreplace.test.
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
# and the interpreted version are the same, not whether the interpreted
# version is correct.
apply {{} {
    set lss     {{} {a} {a b c} {a b c d}}
    set ins     {{} A {A B}}
    set idxs    {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2}
    set lreplace lreplace
return
    foreach ls $lss {
	foreach a $idxs {
	    foreach b $idxs {
		foreach i $ins {
		    set expected [list [catch {$lreplace $ls $a $b {*}$i} m] $m]
		    set tester [list lreplace $ls $a $b {*}$i]
		    set script [list catch $tester m]







|







215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
# and the interpreted version are the same, not whether the interpreted
# version is correct.
apply {{} {
    set lss     {{} {a} {a b c} {a b c d}}
    set ins     {{} A {A B}}
    set idxs    {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2}
    set lreplace lreplace

    foreach ls $lss {
	foreach a $idxs {
	    foreach b $idxs {
		foreach i $ins {
		    set expected [list [catch {$lreplace $ls $a $b {*}$i} m] $m]
		    set tester [list lreplace $ls $a $b {*}$i]
		    set script [list catch $tester m]
Changes to tests/lseq.test.
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
} -cleanup {
    unset res
} -result {0 10 0 10 0 9223372036854774991 0 10 0 2147483638}

# Ticket 99e834bf33 - lseq, lindex end off by one

test lseq-4.5 {lindex off by one} -body {
    set res {}
    lappend res [eval {lindex [lseq 1 4] end}]
    lappend res [eval {lindex [lseq 1 4] end-1}]
} -setup {
    # Since 4.3 does not clean up and 4.4 may not run under constraint
    set res {}
} -cleanup {
    unset res







<







501
502
503
504
505
506
507

508
509
510
511
512
513
514
} -cleanup {
    unset res
} -result {0 10 0 10 0 9223372036854774991 0 10 0 2147483638}

# Ticket 99e834bf33 - lseq, lindex end off by one

test lseq-4.5 {lindex off by one} -body {

    lappend res [eval {lindex [lseq 1 4] end}]
    lappend res [eval {lindex [lseq 1 4] end-1}]
} -setup {
    # Since 4.3 does not clean up and 4.4 may not run under constraint
    set res {}
} -cleanup {
    unset res
Changes to tests/stringObj.test.
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

test stringObj-1.1 {string type registration} testobj {
    set t [testobj types]
    set first [string first "string" $t]
    set result [expr {$first >= 0}]
} 1

set INT_MAX 0x7fffffff; # Assumes sizeof(int) == 4
set SIZE_MAX [expr {(1 << (8*$::tcl_platform(pointerSize) - 1)) - 1}]

test stringObj-2.1 {Tcl_NewStringObj} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [teststringobj set 1 abcd]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} abcd string 2}







<
<
<







27
28
29
30
31
32
33



34
35
36
37
38
39
40

test stringObj-1.1 {string type registration} testobj {
    set t [testobj types]
    set first [string first "string" $t]
    set result [expr {$first >= 0}]
} 1




test stringObj-2.1 {Tcl_NewStringObj} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [teststringobj set 1 abcd]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} abcd string 2}
499
500
501
502
503
504
505
506
507
508
509
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
541
542
    teststringobj range 1 -1 -1
} abcde
test stringObj-16.6 {Tcl_GetRange: old anomaly} testobj {
    # Older implementations could return "cde"
    teststringobj set 1 abcde
    teststringobj range 1 2 0
} {}
test stringObj-16.7 {Tcl_GetRange: first = INT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 [expr {$INT_MAX-1}] 3
} {}
test stringObj-16.8 {Tcl_GetRange: first = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 [expr {$SIZE_MAX - 1}] 3
} {}
test stringObj-16.9 {Tcl_GetRange: last = INT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 1 [expr {$INT_MAX-1}]
} bcde
test stringObj-16.10 {Tcl_GetRange: last = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 1 [expr {$SIZE_MAX - 1}] 
} bcde
test stringObj-16.11 {Tcl_GetRange: first = last = INT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 [expr {$INT_MAX-1}] [expr {$INT_MAX-1}]
} {}
test stringObj-16.12 {Tcl_GetRange: first = last = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde
    set i [expr {$SIZE_MAX - 1}]
    teststringobj range 1 $i $i
} {}

if {[testConstraint testobj]} {
    testobj freeallvars
}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







|

|



|

|

|



|

|

|



<
|













496
497
498
499
500
501
502
503
504
505
506
507
508
509
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
    teststringobj range 1 -1 -1
} abcde
test stringObj-16.6 {Tcl_GetRange: old anomaly} testobj {
    # Older implementations could return "cde"
    teststringobj set 1 abcde
    teststringobj range 1 2 0
} {}
test stringObj-16.7 {Tcl_GetRange: first = UINT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 0xFFFFFFFE 3
} {}
test stringObj-16.8 {Tcl_GetRange: first = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 -2 3
} {}
test stringObj-16.9 {Tcl_GetRange: last = UINT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 1 0xFFFFFFFE
} bcde
test stringObj-16.10 {Tcl_GetRange: last = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 1 -2
} bcde
test stringObj-16.11 {Tcl_GetRange: first = last = UINT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 0xFFFFFFFE 0xFFFFFFFE
} {}
test stringObj-16.12 {Tcl_GetRange: first = last = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde

    teststringobj range 1 -2 -2
} {}

if {[testConstraint testobj]} {
    testobj freeallvars
}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:
Changes to tools/regexpTestLib.tcl.
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

    close $fileId
    return $i
}

#
# strings with embedded @'s are truncated
# unpreceeded @'s are replaced by {}
#
proc removeAts {ls} {
    set len [llength $ls]
    set newLs {}
    foreach item $ls {
	regsub @.* $item "" newItem
	lappend newLs $newItem







|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

    close $fileId
    return $i
}

#
# strings with embedded @'s are truncated
# unpreceded @'s are replaced by {}
#
proc removeAts {ls} {
    set len [llength $ls]
    set newLs {}
    foreach item $ls {
	regsub @.* $item "" newItem
	lappend newLs $newItem
Changes to win/tclAppInit.c.
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
    /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main((size_t)argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --







|







137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
    /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --