Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Merge 8.7 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
b7639c0e3d0c9c9aa0f8c84798586aa0 |
| User & Date: | jan.nijtmans 2019-01-13 15:47:18 |
Context
|
2019-01-14
| ||
| 20:03 | merge 8.7 (mingw/win-autoconf build, etc) check-in: d269eeed5d user: sebres tags: trunk | |
|
2019-01-13
| ||
| 15:47 | Merge 8.7 check-in: b7639c0e3d user: jan.nijtmans tags: trunk | |
| 15:43 | Merge 8.6 check-in: 372ad13f77 user: jan.nijtmans tags: core-8-branch | |
|
2019-01-09
| ||
| 10:11 | merge 8.7 (regression bug-[cc1e91552c], etc) check-in: 0908eff9e9 user: sebres tags: trunk | |
Changes
Changes to generic/tclExecute.c.
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
....
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
|
NEXT_INST_F(10, 1, 0);
}
#endif
/* Every range of an empty list is an empty list */
if (objc == 0) {
/* avoid return of not canonical list (e. g. spaces in string repr.) */
if (ListObjIsCanonical(valuePtr)) {
TRACE_APPEND(("\n"));
NEXT_INST_F(9, 0, 0);
}
goto emptyList;
}
/* Decode index value operands. */
................................................................................
toIdx = TclIndexDecode(toIdx, slength - 1);
if (toIdx < 0) {
goto emptyRange;
} else if (toIdx >= (int)slength) {
toIdx = slength - 1;
}
assert ( toIdx >= 0 && toIdx < slength );
/*
assert ( fromIdx != TCL_INDEX_BEFORE );
assert ( fromIdx != TCL_INDEX_AFTER);
*
* Extra safety for legacy bytecodes:
*/
|
|
|
|
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
....
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
|
NEXT_INST_F(10, 1, 0);
}
#endif
/* Every range of an empty list is an empty list */
if (objc == 0) {
/* avoid return of not canonical list (e. g. spaces in string repr.) */
if (!valuePtr->bytes || !valuePtr->bytes[0]) {
TRACE_APPEND(("\n"));
NEXT_INST_F(9, 0, 0);
}
goto emptyList;
}
/* Decode index value operands. */
................................................................................
toIdx = TclIndexDecode(toIdx, slength - 1);
if (toIdx < 0) {
goto emptyRange;
} else if (toIdx >= (int)slength) {
toIdx = slength - 1;
}
assert ( toIdx >= 0 && (size_t)toIdx < slength );
/*
assert ( fromIdx != TCL_INDEX_BEFORE );
assert ( fromIdx != TCL_INDEX_AFTER);
*
* Extra safety for legacy bytecodes:
*/
|
Changes to generic/tclTest.c.
222 223 224 225 226 227 228 229 230 231 232 233 234 235 ... 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 ... 575 576 577 578 579 580 581 582 583 584 585 586 587 588 .... 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 .... 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 |
static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); static void SpecialFree(void *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static int TestasyncCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestbytestringObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TeststringbytesObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestcmdinfoCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestcmdtokenCmd(void *dummy, ................................................................................ static int TestdcallCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestdelCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestdelassocdataCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestdoubledigitsObjCmd(void *dummy, Tcl_Interp* interp, int objc, Tcl_Obj* const objv[]); static int TestdstringCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestencodingObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestevalexObjCmd(void *dummy, Tcl_Interp *interp, int objc, ................................................................................ /* * Create additional commands and math functions for testing Tcl. */ Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, ................................................................................ Tcl_Obj *const objv[]) /* Argument objects. */ { int length, flags; const char *script; flags = 0; if (objc == 3) { const char *global = Tcl_GetStringFromObj(objv[2], &length); if (strcmp(global, "global") != 0) { Tcl_AppendResult(interp, "bad value \"", global, "\": must be global", NULL); return TCL_ERROR; } flags = TCL_EVAL_GLOBAL; } else if (objc != 2) { ................................................................................ Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } p = (const unsigned char *)Tcl_GetStringFromObj(objv[1], &n); Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(p, n)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestbytestringObjCmd -- * * This object-based procedure constructs a string which can |
> > > | | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 ... 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 ... 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 .... 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 .... 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 |
static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); static void SpecialFree(void *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static int TestasyncCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestbytestringObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestpurebytesobjObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TeststringbytesObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestcmdinfoCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestcmdtokenCmd(void *dummy, ................................................................................ static int TestdcallCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestdelCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestdelassocdataCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestdoubledigitsObjCmd(void *dummy, Tcl_Interp* interp, int objc, Tcl_Obj* const objv[]); static int TestdstringCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestencodingObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestevalexObjCmd(void *dummy, Tcl_Interp *interp, int objc, ................................................................................ /* * Create additional commands and math functions for testing Tcl. */ Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, ................................................................................ Tcl_Obj *const objv[]) /* Argument objects. */ { int length, flags; const char *script; flags = 0; if (objc == 3) { const char *global = Tcl_GetString(objv[2]); if (strcmp(global, "global") != 0) { Tcl_AppendResult(interp, "bad value \"", global, "\": must be global", NULL); return TCL_ERROR; } flags = TCL_EVAL_GLOBAL; } else if (objc != 2) { ................................................................................ Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } p = (const unsigned char *)Tcl_GetStringFromObj(objv[1], &n); Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(p, n)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestpurebytesobjObjCmd -- * * This object-based procedure constructs a pure bytes object * without type and with internal representation containing NULL's. * * If no argument supplied it returns empty object with tclEmptyStringRep, * otherwise it returns this as pure bytes object with bytes value equal * string. * * Results: * Returns the TCL_OK result code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestpurebytesobjObjCmd( ClientData unused, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_Obj *objPtr; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?string?"); return TCL_ERROR; } objPtr = Tcl_NewObj(); /* objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->internalRep.twoPtrValue.ptr2 = NULL; */ memset(&objPtr->internalRep, 0, sizeof(objPtr->internalRep)); if (objc == 2) { const char *s = Tcl_GetString(objv[1]); objPtr->length = objv[1]->length; objPtr->bytes = ckalloc(objPtr->length + 1); memcpy(objPtr->bytes, s, objPtr->length); objPtr->bytes[objPtr->length] = 0; } Tcl_SetObjResult(interp, objPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestbytestringObjCmd -- * * This object-based procedure constructs a string which can |
Changes to tests/lrange.test.
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
test lrange-1.1 {range of list elements} {
lrange {a b c d} 1 2
} {b c}
test lrange-1.2 {range of list elements} {
lrange {a {bcd e {f g {}}} l14 l15 d} 1 1
} {{bcd e {f g {}}}}
................................................................................
[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]} {
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]
} [lrepeat 6 {}]
test lrange-4.1 {lrange pure promise} -body {
set ll1 [list $tcl_version 2 3 4]
# Shared
set ll2 $ll1
# With string rep
string length $ll1
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
...
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
145
146
147
148
149
150
151
|
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testpurebytesobj [llength [info commands testpurebytesobj]]
test lrange-1.1 {range of list elements} {
lrange {a b c d} 1 2
} {b c}
test lrange-1.2 {range of list elements} {
lrange {a {bcd e {f g {}}} l14 l15 d} 1 1
} {{bcd e {f g {}}}}
................................................................................
[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]} {
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]
} [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]
} [lrepeat 6 {}]
test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} {
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]
} [lrepeat 6 {}]
test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} {
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]
} [lrepeat 6 {}]
test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} {
set cmd lrange
list [$cmd [testpurebytesobj] 0 1] [$cmd [testpurebytesobj { }] 0 1] [$cmd [set a [testpurebytesobj {}]] 0 1] \
[$cmd [testpurebytesobj] 0-1 end+1] [$cmd [testpurebytesobj { }] 0-1 end+1] [$cmd $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-4.1 {lrange pure promise} -body {
set ll1 [list $tcl_version 2 3 4]
# Shared
set ll2 $ll1
# With string rep
string length $ll1
|