summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclBinary.c65
-rw-r--r--generic/tclEnv.c65
-rw-r--r--generic/tclInt.h2
-rw-r--r--tests/env.test20
-rw-r--r--tests/lindex.test121
-rw-r--r--tests/lrange.test25
-rw-r--r--tests/lreplace.test32
-rw-r--r--tests/regexp.test180
-rw-r--r--tests/regexpComp.test48
-rw-r--r--tests/string.test172
-rw-r--r--tests/util.test24
-rw-r--r--win/tclWinInit.c16
12 files changed, 431 insertions, 339 deletions
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 827dabf..d368594 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -431,6 +431,53 @@ Tcl_SetByteArrayObj(
/*
*----------------------------------------------------------------------
*
+ * TclGetBytesFromObj --
+ *
+ * Attempt to extract the value from objPtr in the representation
+ * of a byte sequence. On success return the extracted byte sequence.
+ * On failures, return NULL and record error message and code in
+ * interp (if not NULL).
+ *
+ * Results:
+ * Pointer to array of bytes, or NULL. representing the ByteArray object.
+ * Writes number of bytes in array to *lengthPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned char *
+TclGetBytesFromObj(
+ Tcl_Interp *interp, /* For error reporting */
+ Tcl_Obj *objPtr, /* Value to extract from */
+ int *lengthPtr) /* If non-NULL, filled with length of the
+ * array of bytes in the ByteArray object. */
+{
+ ByteArray *baPtr;
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+
+ if (irPtr == NULL) {
+ SetByteArrayFromAny(NULL, objPtr);
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected bytes but got non-byte character"));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL);
+ }
+ return NULL;
+ }
+ }
+ baPtr = GET_BYTEARRAY(irPtr);
+
+ if (lengthPtr != NULL) {
+ *lengthPtr = baPtr->used;
+ }
+ return baPtr->bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetByteArrayFromObj --
*
* Attempt to get the array of bytes from the Tcl object. If the object
@@ -453,18 +500,16 @@ Tcl_GetByteArrayFromObj(
* array of bytes in the ByteArray object. */
{
ByteArray *baPtr;
- const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ const Tcl_ObjIntRep *irPtr;
+ unsigned char *result = TclGetBytesFromObj(NULL, objPtr, lengthPtr);
- if (irPtr == NULL) {
- irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
- if (irPtr == NULL) {
- SetByteArrayFromAny(NULL, objPtr);
- irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
- if (irPtr == NULL) {
- irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
- }
- }
+ if (result) {
+ return result;
}
+
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ assert(irPtr != NULL);
+
baPtr = GET_BYTEARRAY(irPtr);
if (lengthPtr != NULL) {
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index bbbf977..bc51e0d 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -34,6 +34,27 @@ static struct {
#endif
} env;
+#if defined(_WIN32)
+# define tenviron _wenviron
+# define tenviron2utfdstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
+ (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)))
+# define utf2tenvirondstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
+ (const WCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr)))
+# define techar WCHAR
+# ifdef USE_PUTENV
+# define putenv(env) _wputenv((const wchar_t *)env)
+# endif
+#else
+# define tenviron environ
+# define tenviron2utfdstr(tenvstr, len, dstr) \
+ Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr)
+# define utf2tenvirondstr(str, len, dstr) \
+ Tcl_UtfToExternalDString(NULL, str, len, dstr)
+# define techar char
+#endif
+
+#define tNTL sizeof(techar)
+
/*
* Declarations for local functions defined in this file:
*/
@@ -113,16 +134,16 @@ TclSetupEnv(
* will hold just the parts to remove.
*/
- if (environ[0] != NULL) {
+ if (tenviron[0] != NULL) {
int i;
Tcl_MutexLock(&envMutex);
- for (i = 0; environ[i] != NULL; i++) {
+ for (i = 0; tenviron[i] != NULL; i++) {
Tcl_Obj *obj1, *obj2;
const char *p1;
char *p2;
- p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
+ p1 = tenviron2utfdstr(tenviron[i], -1, &envString);
p2 = (char *)strchr(p1, '=');
if (p2 == NULL) {
/*
@@ -219,7 +240,7 @@ TclSetEnv(
size_t nameLength, valueLength;
size_t index, length;
char *p, *oldValue;
- const char *p2;
+ const techar *p2;
/*
* Figure out where the entry is going to go. If the name doesn't already
@@ -238,18 +259,18 @@ TclSetEnv(
* environment is the one we allocated. [Bug 979640]
*/
- if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
+ if ((env.ourEnviron != (char *)tenviron) || (length+2 > env.ourEnvironSize)) {
char **newEnviron = (char **)Tcl_Alloc((length + 5) * sizeof(char *));
- memcpy(newEnviron, environ, length * sizeof(char *));
+ memcpy(newEnviron, tenviron, length * sizeof(char *));
if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
Tcl_Free(env.ourEnviron);
}
- environ = env.ourEnviron = newEnviron;
+ tenviron = (techar **)(env.ourEnviron = newEnviron);
env.ourEnvironSize = length + 5;
}
index = length;
- environ[index + 1] = NULL;
+ tenviron[index + 1] = NULL;
#endif /* USE_PUTENV */
oldValue = NULL;
nameLength = strlen(name);
@@ -264,7 +285,7 @@ TclSetEnv(
* interpreters.
*/
- oldEnv = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
+ oldEnv = tenviron2utfdstr(tenviron[index], -1, &envString);
if (strcmp(value, oldEnv + (length + 1)) == 0) {
Tcl_DStringFree(&envString);
Tcl_MutexUnlock(&envMutex);
@@ -272,7 +293,7 @@ TclSetEnv(
}
Tcl_DStringFree(&envString);
- oldValue = environ[index];
+ oldValue = (char *)tenviron[index];
nameLength = length;
}
@@ -287,14 +308,14 @@ TclSetEnv(
memcpy(p, name, nameLength);
p[nameLength] = '=';
memcpy(p+nameLength+1, value, valueLength+1);
- p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
+ p2 = utf2tenvirondstr(p, -1, &envString);
/*
* Copy the native string to heap memory.
*/
- p = (char *)Tcl_Realloc(p, Tcl_DStringLength(&envString) + 1);
- memcpy(p, p2, Tcl_DStringLength(&envString) + 1);
+ p = (char *)Tcl_Realloc(p, Tcl_DStringLength(&envString) + tNTL);
+ memcpy(p, p2, Tcl_DStringLength(&envString) + tNTL);
Tcl_DStringFree(&envString);
#ifdef USE_PUTENV
@@ -305,7 +326,7 @@ TclSetEnv(
putenv(p);
index = TclpFindVariable(name, &length);
#else
- environ[index] = p;
+ tenviron[index] = (techar *)p;
#endif /* USE_PUTENV */
/*
@@ -314,7 +335,7 @@ TclSetEnv(
* string in the cache.
*/
- if ((index != TCL_INDEX_NONE) && (environ[index] == p)) {
+ if ((index != TCL_INDEX_NONE) && (tenviron[index] == (techar *)p)) {
ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
} else {
@@ -439,7 +460,7 @@ TclUnsetEnv(
* Remember the old value so we can free it if Tcl created the string.
*/
- oldValue = environ[index];
+ oldValue = (char *)tenviron[index];
/*
* Update the system environment. This must be done before we update the
@@ -463,10 +484,10 @@ TclUnsetEnv(
string[length] = '\0';
#endif /* _WIN32 */
- Tcl_UtfToExternalDString(NULL, string, -1, &envString);
- string = (char *)Tcl_Realloc(string, Tcl_DStringLength(&envString) + 1);
+ utf2tenvirondstr(string, -1, &envString);
+ string = (char *)Tcl_Realloc(string, Tcl_DStringLength(&envString) + tNTL);
memcpy(string, Tcl_DStringValue(&envString),
- Tcl_DStringLength(&envString)+1);
+ Tcl_DStringLength(&envString) + tNTL);
Tcl_DStringFree(&envString);
putenv(string);
@@ -477,7 +498,7 @@ TclUnsetEnv(
* string in the cache.
*/
- if (environ[index] == string) {
+ if (tenviron[index] == (techar *)string) {
ReplaceString(oldValue, string);
#ifdef HAVE_PUTENV_THAT_COPIES
} else {
@@ -489,7 +510,7 @@ TclUnsetEnv(
#endif /* HAVE_PUTENV_THAT_COPIES */
}
#else /* !USE_PUTENV_FOR_UNSET */
- for (envPtr = environ+index+1; ; envPtr++) {
+ for (envPtr = (char **)(tenviron+index+1); ; envPtr++) {
envPtr[-1] = *envPtr;
if (*envPtr == NULL) {
break;
@@ -538,7 +559,7 @@ TclGetEnv(
if (index != TCL_AUTO_LENGTH) {
Tcl_DString envStr;
- result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
+ result = tenviron2utfdstr(tenviron[index], -1, &envStr);
result += length;
if (*result == '=') {
result++;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 452d915..1f9bd11 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2957,6 +2957,8 @@ MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
MODULE_SCOPE int * TclGetAsyncReadyPtr(void);
MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp);
+MODULE_SCOPE unsigned char * TclGetBytesFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int *lengthPtr);
MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
int *modePtr, int flags);
diff --git a/tests/env.test b/tests/env.test
index 79a353a..4af46c3 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -219,6 +219,26 @@ test env-2.4 {
NAME2=more
XYZZY=garbage}
+test env-2.5 {different encoding (wide chars)} -constraints {win exec} -setup {
+ # be sure set of (unicode) environment occurs if single-byte encoding is used:
+ encodingswitch cp1252
+ # german (cp1252) and russian (cp1251) characters together encoded as utf-8:
+ set val 2d2dc3a4c3b6c3bcc39f2dd182d0b5d181d1822d2d
+ set env(XYZZY) [encoding convertfrom utf-8 [binary decode hex $val]]
+ # now switch to utf-8 (to see correct values from test):
+ encoding system utf-8
+} -body {
+ exec [interpreter] << [string map [list \$val $val] {
+ encoding system utf-8; fconfigure stdout -encoding utf-8
+ set test [encoding convertfrom utf-8 [binary decode hex $val]]
+ puts "[expr {$env(XYZZY) eq $test}] \ngot:\t\
+ $env(XYZZY) ([binary encode hex [encoding convertto $env(XYZZY)]]) \nexp:\t\
+ $test ([binary encode hex [encoding convertto $test]])"
+ }]
+} -cleanup {
+ encodingrestore
+ unset -nocomplain val f env(XYZZY)
+} -match glob -result {1 *}
test env-3.1 {
changing environment variables
diff --git a/tests/lindex.test b/tests/lindex.test
index 9de08c1..1be489e 100644
--- a/tests/lindex.test
+++ b/tests/lindex.test
@@ -51,22 +51,22 @@ test lindex-2.4 {malformed index list} testevalex {
# Indices that are integers or convertible to integers
-test lindex-3.1 {integer -1} testevalex {
+test lindex-3.1 {integer -1} -constraints testevalex -body {
set x ${minus}1
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
-} {{} {}}
-test lindex-3.2 {integer 0} testevalex {
+} -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}]
-} {a a}
-test lindex-3.3 {integer 2} testevalex {
+} -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}]
-} {c c}
-test lindex-3.4 {integer 3} testevalex {
+} -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
@@ -75,19 +75,19 @@ test lindex-3.6 {bad octal} -constraints testevalex -body {
set x -0o9
list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
-test lindex-3.7 {indexes don't shimmer wide ints} {
+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]
-} {2147483646 {} 2147483647 2147483648}
-test lindex-3.8 {compiled with static indices out of range, negative} {
+} -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]
-} [lrepeat 3 {}]
-test lindex-3.9 {compiled with calculated indices out of range, negative constant} {
+} -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]
-} [lrepeat 3 {}]
-test lindex-3.10 {compiled with calculated indices out of range, after end} {
+} -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]
-} [lrepeat 3 {}]
+} -result [lrepeat 3 {}]
# Indices relative to end
@@ -165,34 +165,38 @@ test lindex-7.4 {quoted elements} {
lindex {a b {c d "e} {f g"}} 2
} {c d "e}
-test lindex-8.1 {data reuse} testevalex {
+test lindex-8.1 {data reuse} -constraints testevalex -body {
set x 0
testevalex {lindex $x $x}
-} {0}
-test lindex-8.2 {data reuse} testevalex {
+} -result 0
+test lindex-8.2 {data reuse} -constraints testevalex -body {
set a 0
testevalex {lindex $a $a $a}
-} 0
-test lindex-8.3 {data reuse} testevalex {
+} -result 0
+test lindex-8.3 {data reuse} -constraints {
+ testevalex
+} -body {
set a 1
testevalex {lindex $a $a $a}
-} {}
-test lindex-8.4 {data reuse} testevalex {
+} -result {}
+test lindex-8.4 {data reuse} -constraints testevalex -body {
set x [list 0 0]
testevalex {lindex $x $x}
-} {0}
-test lindex-8.5 {data reuse} testevalex {
+} -result 0
+test lindex-8.5 {data reuse} -constraints testevalex -body {
set x 0
testevalex {lindex $x [list $x $x]}
-} {0}
-test lindex-8.6 {data reuse} testevalex {
+} -result 0
+test lindex-8.6 {data reuse} -constraints testevalex -body {
set x [list 1 1]
testevalex {lindex $x $x}
-} {}
-test lindex-8.7 {data reuse} testevalex {
+} -result {}
+test lindex-8.7 {data reuse} -constraints {
+ testevalex
+} -body {
set x 1
testevalex {lindex $x [list $x $x]}
-} {}
+} -result {}
#----------------------------------------------------------------------
@@ -381,80 +385,69 @@ test lindex-15.3 {quoted elements} {
} result
set result
} {c d " x}
-test lindex-15.4 {quoted elements} {
+test lindex-15.4 {quoted elements} -body {
catch {
lindex {a b {c d "e} {f g"}} 2
} result
set result
-} {c d "e}
+} -result {c d "e}
-test lindex-16.1 {data reuse} {
+test lindex-16.1 {data reuse} -body {
set x 0
catch {
lindex $x $x
} result
set result
-} {0}
-test lindex-16.2 {data reuse} {
+} -result {0}
+test lindex-16.2 {data reuse} -body {
set a 0
catch {
lindex $a $a $a
} result
set result
-} 0
-test lindex-16.3 {data reuse} {
+} -result 0
+test lindex-16.3 {data reuse} -body {
set a 1
catch {
lindex $a $a $a
} result
set result
-} {}
-test lindex-16.4 {data reuse} {
+} -result {}
+test lindex-16.4 {data reuse} -body {
set x [list 0 0]
catch {
lindex $x $x
} result
set result
-} {0}
-test lindex-16.5 {data reuse} {
+} -result {0}
+test lindex-16.5 {data reuse} -body {
set x 0
catch {
lindex $x [list $x $x]
} result
set result
-} {0}
-test lindex-16.6 {data reuse} {
+} -result {0}
+test lindex-16.6 {data reuse} -body {
set x [list 1 1]
catch {
lindex $x $x
} result
set result
-} {}
-test lindex-16.7 {data reuse} {
+} -result {}
+test lindex-16.7 {data reuse} -body {
set x 1
catch {
lindex $x [list $x $x]
} result
set result
-} {}
-
-test lindex-17.0 {Bug 1718580} {*}{
- -body {
- lindex {} end foo
- }
- -match glob
- -result {bad index "foo"*}
- -returnCodes 1
-}
-
-test lindex-17.1 {Bug 1718580} {*}{
- -body {
- lindex a end foo
- }
- -match glob
- -result {bad index "foo"*}
- -returnCodes 1
-}
+} -result {}
+
+test lindex-17.0 {Bug 1718580} -body {
+ lindex {} end foo
+} -match glob -result {bad index "foo"*} -returnCodes 1
+test lindex-17.1 {Bug 1718580} -body {
+ lindex a end foo
+} -match glob -result {bad index "foo"*} -returnCodes 1
catch { unset minus }
diff --git a/tests/lrange.test b/tests/lrange.test
index 4f7c0d3..5798707 100644
--- a/tests/lrange.test
+++ b/tests/lrange.test
@@ -20,7 +20,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
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
@@ -102,9 +101,9 @@ test lrange-3.2 {compiled with static indices out of range, negative} {
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]
} [lrepeat 4 {}]
-test lrange-3.4 {compiled with calculated indices out of range, after end} {
+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]
-} [lrepeat 4 {}]
+} -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]
@@ -117,22 +116,22 @@ test lrange-3.7a {compiled on empty not canonical list (with static and dynamic
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]} {
+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]
-} [lrepeat 6 {}]
+} -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]
} [lrepeat 6 {}]
-test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} {
+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]
-} [lrepeat 6 {}]
+} -result [lrepeat 6 {}]
test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints {
testpurebytesobj
} -body {
@@ -226,24 +225,24 @@ apply {{} {
set tester [list lrange $ls $a $b]
set script [list catch $tester m]
set script "list \[$script\] \$m"
- test lrange-5.[incr n].1 {lrange shared compiled} \
- [list apply [list {} $script]] $expected
+ test lrange-5.[incr n].1 {lrange shared compiled} -body \
+ [list apply [list {} $script]] -result $expected
# Unshared, uncompiled
set tester [string map [list %l [list $ls] %a $a %b $b] {
[string cat l range] [lrange %l 0 end] %a %b
}]
set script [list catch $tester m]
set script "list \[$script\] \$m"
- test lrange-5.$n.2 {lrange unshared uncompiled} \
- [list apply [list {} $script]] $expected
+ test lrange-5.$n.2 {lrange unshared uncompiled} -body \
+ [list apply [list {} $script]] -result $expected
# Unshared, compiled
set tester [string map [list %l [list $ls] %a $a %b $b] {
lrange [lrange %l 0 end] %a %b
}]
set script [list catch $tester m]
set script "list \[$script\] \$m"
- test lrange-5.$n.3 {lrange unshared compiled} \
- [list apply [list {} $script]] $expected
+ test lrange-5.$n.3 {lrange unshared compiled} -body \
+ [list apply [list {} $script]] -result $expected
}
}
}
diff --git a/tests/lreplace.test b/tests/lreplace.test
index fd2f7f8..4ce3ef4 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -111,27 +111,27 @@ test lreplace-1.30 {lreplace command} -body {
lreplace {not {}alist} 0 0 [error foo]
} -returnCodes 1 -result {foo}
-test lreplace-2.1 {lreplace errors} {
+test lreplace-2.1 {lreplace errors} -body {
list [catch lreplace msg] $msg
-} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
-test lreplace-2.2 {lreplace errors} {
+} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
+test lreplace-2.2 {lreplace errors} -body {
list [catch {lreplace a b} msg] $msg
-} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
-test lreplace-2.3 {lreplace errors} {
+} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
+test lreplace-2.3 {lreplace errors} -body {
list [catch {lreplace x a 10} msg] $msg
-} {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}}
-test lreplace-2.4 {lreplace errors} {
+} -result {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}}
+test lreplace-2.4 {lreplace errors} -body {
list [catch {lreplace x 10 x} msg] $msg
-} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}}
-test lreplace-2.5 {lreplace errors} {
+} -result {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}}
+test lreplace-2.5 {lreplace errors} -body {
list [catch {lreplace x 10 1x} msg] $msg
-} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
-test lreplace-2.6 {lreplace errors} {
+} -result {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
+test lreplace-2.6 {lreplace errors} -body {
list [catch {lreplace x 3 2} msg] $msg
-} {0 x}
-test lreplace-2.7 {lreplace errors} {
+} -result {0 x}
+test lreplace-2.7 {lreplace errors} -body {
list [catch {lreplace x 2 2} msg] $msg
-} {0 x}
+} -result {0 x}
test lreplace-3.1 {lreplace won't modify shared argument objects} {
proc p {} {
@@ -228,8 +228,8 @@ apply {{} {
set tester [list lreplace $ls $a $b {*}$i]
set script [list catch $tester m]
set script "list \[$script\] \$m"
- test lreplace-6.[incr n] {lreplace battery} \
- [list apply [list {} $script]] $expected
+ test lreplace-6.[incr n] {lreplace battery} -body \
+ [list apply [list {} $script]] -result $expected
}
}
}
diff --git a/tests/regexp.test b/tests/regexp.test
index 7367af7..bae1217 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -542,133 +542,133 @@ test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -co
removeFile junk.tcl
} -result 1
-test regexp-15.1 {regexp -start} {
+test regexp-15.1 {regexp -start} -body {
unset -nocomplain x
list [regexp -start -10 {\d} 1abc2de3 x] $x
-} {1 1}
-test regexp-15.2 {regexp -start} {
+} -result {1 1}
+test regexp-15.2 {regexp -start} -body {
unset -nocomplain x
list [regexp -start 2 {\d} 1abc2de3 x] $x
-} {1 2}
-test regexp-15.3 {regexp -start} {
+} -result {1 2}
+test regexp-15.3 {regexp -start} -body {
unset -nocomplain x
list [regexp -start 4 {\d} 1abc2de3 x] $x
-} {1 2}
-test regexp-15.4 {regexp -start} {
+} -result {1 2}
+test regexp-15.4 {regexp -start} -body {
unset -nocomplain x
list [regexp -start 5 {\d} 1abc2de3 x] $x
-} {1 3}
-test regexp-15.5 {regexp -start, over end of string} {
+} -result {1 3}
+test regexp-15.5 {regexp -start, over end of string} -body {
unset -nocomplain x
list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
-} {0 0}
-test regexp-15.6 {regexp -start, loss of ^$ behavior} {
+} -result {0 0}
+test regexp-15.6 {regexp -start, loss of ^$ behavior} -body {
list [regexp -start 2 {^$} {}]
-} {0}
-test regexp-15.7 {regexp -start, double option} {
+} -result {0}
+test regexp-15.7 {regexp -start, double option} -body {
regexp -start 2 -start 0 a abc
-} 1
-test regexp-15.8 {regexp -start, double option} {
+} -result 1
+test regexp-15.8 {regexp -start, double option} -body {
regexp -start 0 -start 2 a abc
-} 0
-test regexp-15.9 {regexp -start, end relative index} {
+} -result 0
+test regexp-15.9 {regexp -start, end relative index} -body {
unset -nocomplain x
list [regexp -start end {\d} 1abc2de3 x] [info exists x]
-} {0 0}
-test regexp-15.10 {regexp -start, end relative index} {
+} -result {0 0}
+test regexp-15.10 {regexp -start, end relative index} -body {
unset -nocomplain x
list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x
-} {1 1 3}
-test regexp-15.11 {regexp -start, over end of string} {
+} -result {1 1 3}
+test regexp-15.11 {regexp -start, over end of string} -body {
set x NA
list [regexp -start 2 {.*} ab x] $x
-} {1 {}}
+} -result {1 {}}
-test regexp-16.1 {regsub -start} {
+test regexp-16.1 {regsub -start} -body {
unset -nocomplain x
list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
-} {4 a1b/2c/3d/4e/5}
-test regexp-16.2 {regsub -start} {
+} -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
-} {0 hello}
-test regexp-16.3 {regsub -start} {
+} -result {0 hello}
+test regexp-16.3 {regsub -start} -body {
unset -nocomplain x
list [regsub -all -start 3 {z} hello {/&} x] $x
-} {0 hello}
-test regexp-16.4 {regsub -start, \A behavior} {
+} -result {0 hello}
+test regexp-16.4 {regsub -start, \A behavior} -body {
set out {}
lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
-} {5 /a/b/c/d/e 3 ab/c/d/e}
-test regexp-16.5 {regsub -start, double option} {
+} -result {5 /a/b/c/d/e 3 ab/c/d/e}
+test regexp-16.5 {regsub -start, double option} -body {
list [regsub -start 2 -start 0 a abc c x] $x
-} {1 cbc}
-test regexp-16.6 {regsub -start, double option} {
+} -result {1 cbc}
+test regexp-16.6 {regsub -start, double option} -body {
list [regsub -start 0 -start 2 a abc c x] $x
-} {0 abc}
-test regexp-16.7 {regexp -start, end relative index} {
+} -result {0 abc}
+test regexp-16.7 {regexp -start, end relative index} -body {
list [regsub -start end a aaa b x] $x
-} {0 aaa}
-test regexp-16.8 {regexp -start, end relative index} {
+} -result {0 aaa}
+test regexp-16.8 {regexp -start, end relative index} -body {
list [regsub -start end-1 a aaa b x] $x
-} {1 aab}
-test regexp-16.9 {regsub -start and -all} {
+} -result {1 aab}
+test regexp-16.9 {regsub -start and -all} -body {
set foo {}
list [regsub -start 0 -all x+ axxxbxx |&| foo] $foo
-} {2 a|xxx|b|xx|}
-test regexp-16.10 {regsub -start and -all} {
+} -result {2 a|xxx|b|xx|}
+test regexp-16.10 {regsub -start and -all} -body {
set foo {}
list [regsub -start 1 -all x+ axxxbxx |&| foo] $foo
-} {2 a|xxx|b|xx|}
-test regexp-16.11 {regsub -start and -all} {
+} -result {2 a|xxx|b|xx|}
+test regexp-16.11 {regsub -start and -all} -body {
set foo {}
list [regsub -start 4 -all x+ axxxbxx |&| foo] $foo
-} {1 axxxb|xx|}
-test regexp-16.12 {regsub -start} {
+} -result {1 axxxb|xx|}
+test regexp-16.12 {regsub -start} -body {
set foo {}
list [regsub -start 4 x+ axxxbxx |&| foo] $foo
-} {1 axxxb|xx|}
-test regexp-16.13 {regsub -start and -all} {
+} -result {1 axxxb|xx|}
+test regexp-16.13 {regsub -start and -all} -body {
set foo {}
list [regsub -start 1 -all a+ "" & foo] $foo
-} {0 {}}
-test regexp-16.14 {regsub -start} {
+} -result {0 {}}
+test regexp-16.14 {regsub -start} -body {
set foo {}
list [regsub -start 1 a+ "" & foo] $foo
-} {0 {}}
-test regexp-16.15 {regsub -start and -all} {
+} -result {0 {}}
+test regexp-16.15 {regsub -start and -all} -body {
set foo {}
list [regsub -start 2 -all a+ "xy" & foo] $foo
-} {0 xy}
-test regexp-16.16 {regsub -start} {
+} -result {0 xy}
+test regexp-16.16 {regsub -start} -body {
set foo {}
list [regsub -start 2 a+ "xy" & foo] $foo
-} {0 xy}
-test regexp-16.17 {regsub -start and -all} {
+} -result {0 xy}
+test regexp-16.17 {regsub -start and -all} -body {
set foo {}
list [regsub -start 1 -all y+ "xy" & foo] $foo
-} {1 xy}
-test regexp-16.18 {regsub -start} {
+} -result {1 xy}
+test regexp-16.18 {regsub -start} -body {
set foo {}
list [regsub -start 1 y+ "xy" & foo] $foo
-} {1 xy}
-test regexp-16.19 {regsub -start} {
+} -result {1 xy}
+test regexp-16.19 {regsub -start} -body {
set foo {}
list [regsub -start -1 a+ "" & foo] $foo
-} {0 {}}
-test regexp-16.20 {regsub -start, loss of ^$ behavior} {
+} -result {0 {}}
+test regexp-16.20 {regsub -start, loss of ^$ behavior} -body {
set foo NA
list [regsub -start 1 {^$} {} & foo] $foo
-} {0 {}}
-test regexp-16.21 {regsub -start, loss of ^$ behavior} {
+} -result {0 {}}
+test regexp-16.21 {regsub -start, loss of ^$ behavior} -body {
set foo NA
list [regsub -start 1 {^.*$} abc & foo] $foo
-} {0 abc}
-test regexp-16.22 {regsub -start, loss of ^$ behavior} {
+} -result {0 abc}
+test regexp-16.22 {regsub -start, loss of ^$ behavior} -body {
set foo NA
list [regsub -all -start 1 {^.*$} abc & foo] $foo
-} {0 abc}
+} -result {0 abc}
test regexp-17.1 {regexp -inline} {
regexp -inline b ababa
@@ -754,45 +754,45 @@ test regexp-19.2 {regsub null replacement} {
string equal $result $expected
} 1
-test regexp-20.1 {regsub shared object shimmering} {
+test regexp-20.1 {regsub shared object shimmering} -body {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
set b $a
set c abcdefghijklmnopqurstuvwxyz0123456789
regsub $a $c $b d
list $d [string length $d] [string bytelength $d]
-} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
-test regexp-20.2 {regsub shared object shimmering with -about} {
+} -result [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
+test regexp-20.2 {regsub shared object shimmering with -about} -body {
eval regexp -about abc
-} {0 {}}
+} -result {0 {}}
-test regexp-21.1 {regsub works with empty string} {
+test regexp-21.1 {regsub works with empty string} -body {
regsub -- ^ {} foo
-} {foo}
-test regexp-21.2 {regsub works with empty string} {
+} -result {foo}
+test regexp-21.2 {regsub works with empty string} -body {
regsub -- \$ {} foo
-} {foo}
-test regexp-21.3 {regsub works with empty string offset} {
+} -result {foo}
+test regexp-21.3 {regsub works with empty string offset} -body {
regsub -start 0 -- ^ {} foo
-} {foo}
-test regexp-21.4 {regsub works with empty string offset} {
+} -result {foo}
+test regexp-21.4 {regsub works with empty string offset} -body {
regsub -start 0 -- \$ {} foo
-} {foo}
-test regexp-21.5 {regsub works with empty string offset} {
+} -result {foo}
+test regexp-21.5 {regsub works with empty string offset} -body {
regsub -start 3 -- \$ {123} foo
-} {123foo}
-test regexp-21.6 {regexp works with empty string} {
+} -result {123foo}
+test regexp-21.6 {regexp works with empty string} -body {
regexp -- ^ {}
-} {1}
-test regexp-21.7 {regexp works with empty string} {
+} -result {1}
+test regexp-21.7 {regexp works with empty string} -body {
regexp -start 0 -- ^ {}
-} {1}
-test regexp-21.8 {regexp works with empty string offset} {
+} -result {1}
+test regexp-21.8 {regexp works with empty string offset} -body {
regexp -start 3 -- ^ {123}
-} {0}
-test regexp-21.9 {regexp works with empty string offset} {
+} -result {0}
+test regexp-21.9 {regexp works with empty string offset} -body {
regexp -start 3 -- \$ {123}
-} {1}
+} -result {1}
test regexp-21.10 {multiple matches handle newlines} {
regsub -all -lineanchor -- {^#[^\n]*\n} "#one\n#two\n#three\n" foo\n
} "foo\nfoo\nfoo\n"
@@ -1096,13 +1096,13 @@ test regexp-26.1 {matches start of line 1 time} {
test regexp-26.2 {matches start of line(s) 2 times} {
regexp -all -inline -line -- {^a+} "aab\naaa"
} {aa aaa}
-test regexp-26.3 {effect of -line -all and -start} {
+test regexp-26.3 {effect of -line -all and -start} -body {
list \
[regexp -all -inline -line -start 0 -- {^a+} "aab\naaa"] \
[regexp -all -inline -line -start 1 -- {^a+} "aab\naaa"] \
[regexp -all -inline -line -start 3 -- {^a+} "aab\naaa"] \
[regexp -all -inline -line -start 4 -- {^a+} "aab\naaa"] \
-} {{aa aaa} aaa aaa aaa}
+} -result {{aa aaa} aaa aaa aaa}
# No regexp-26.4
test regexp-26.5 {match length 0, match length 1} {
regexp -all -inline -line -- {^b*} "a\nb"
diff --git a/tests/regexpComp.test b/tests/regexpComp.test
index fbf8012..8819dd2 100644
--- a/tests/regexpComp.test
+++ b/tests/regexpComp.test
@@ -665,54 +665,54 @@ test regexpComp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache}
removeFile junk.tcl
} -result 1
-test regexpComp-15.1 {regexp -start} {
+test regexpComp-15.1 {regexp -start} -body {
unset -nocomplain x
list [regexp -start -10 {\d} 1abc2de3 x] $x
-} {1 1}
-test regexpComp-15.2 {regexp -start} {
+} -result {1 1}
+test regexpComp-15.2 {regexp -start} -body {
unset -nocomplain x
list [regexp -start 2 {\d} 1abc2de3 x] $x
-} {1 2}
-test regexpComp-15.3 {regexp -start} {
+} -result {1 2}
+test regexpComp-15.3 {regexp -start} -body {
unset -nocomplain x
list [regexp -start 4 {\d} 1abc2de3 x] $x
-} {1 2}
-test regexpComp-15.4 {regexp -start} {
+} -result {1 2}
+test regexpComp-15.4 {regexp -start} -body {
unset -nocomplain x
list [regexp -start 5 {\d} 1abc2de3 x] $x
-} {1 3}
-test regexpComp-15.5 {regexp -start, over end of string} {
+} -result {1 3}
+test regexpComp-15.5 {regexp -start, over end of string} -body {
unset -nocomplain x
list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
-} {0 0}
-test regexpComp-15.6 {regexp -start, loss of ^$ behavior} {
+} -result {0 0}
+test regexpComp-15.6 {regexp -start, loss of ^$ behavior} -body {
list [regexp -start 2 {^$} {}]
-} {0}
+} -result {0}
-test regexpComp-16.1 {regsub -start} {
+test regexpComp-16.1 {regsub -start} -body {
unset -nocomplain x
list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
-} {4 a1b/2c/3d/4e/5}
-test regexpComp-16.2 {regsub -start} {
+} -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
-} {0 hello}
-test regexpComp-16.3 {regsub -start} {
+} -result {0 hello}
+test regexpComp-16.3 {regsub -start} -body {
unset -nocomplain x
list [regsub -all -start 3 {z} hello {/&} x] $x
-} {0 hello}
-test regexpComp-16.4 {regsub -start, \A behavior} {
+} -result {0 hello}
+test regexpComp-16.4 {regsub -start, \A behavior} -body {
set out {}
lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
-} {5 /a/b/c/d/e 3 ab/c/d/e}
+} -result {5 /a/b/c/d/e 3 ab/c/d/e}
-test regexpComp-17.1 {regexp -inline} {
+test regexpComp-17.1 {regexp -inline} -body {
regexp -inline b ababa
-} {b}
-test regexpComp-17.2 {regexp -inline} {
+} -result {b}
+test regexpComp-17.2 {regexp -inline} -body {
regexp -inline (b) ababa
-} {b b}
+} -result {b b}
test regexpComp-17.3 {regexp -inline -indices} {
regexp -inline -indices (b) ababa
} {{1 1} {1 1}}
diff --git a/tests/string.test b/tests/string.test
index 9b51702..3e8e6ae 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -398,44 +398,44 @@ test string-4.10.$noComp {string first, unicode} {
test string-4.11.$noComp {string first, start index} {
run {string first \u7266 abc\u7266x 3}
} 3
-test string-4.12.$noComp {string first, start index} {
+test string-4.12.$noComp {string first, start index} -body {
run {string first \u7266 abc\u7266x 4}
-} -1
-test string-4.13.$noComp {string first, start index} {
+} -result -1
+test string-4.13.$noComp {string first, start index} -body {
run {string first \u7266 abc\u7266x end-2}
-} 3
-test string-4.14.$noComp {string first, negative start index} {
+} -result 3
+test string-4.14.$noComp {string first, negative start index} -body {
run {string first b abc -1}
-} 1
-test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} {
+} -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 \u057E ;# character with two-byte encoding in utf-8
run {string first % %#$uchar$uchar#$uchar$uchar#% 3}
-} 8
-test string-4.16.$noComp {string first, normal string vs pure unicode string} {
+} -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]}
-} {{string 1} {string 0} 2}
-test string-4.17.$noComp {string first, corner case} {
+} -result {{string 1} {string 0} 2}
+test string-4.17.$noComp {string first, corner case} -body {
run {string first a aaa 4294967295}
-} {-1}
-test string-4.18.$noComp {string first, corner case} {
+} -result {-1}
+test string-4.18.$noComp {string first, corner case} -body {
run {string first a aaa -1}
-} {0}
-test string-4.19.$noComp {string first, corner case} {
+} -result {0}
+test string-4.19.$noComp {string first, corner case} -body {
run {string first a aaa end-5}
-} {0}
-test string-4.20.$noComp {string last, corner case} {
+} -result {0}
+test string-4.20.$noComp {string last, corner case} -body {
run {string last a aaa 4294967295}
-} {2}
-test string-4.21.$noComp {string last, corner case} {
+} -result {2}
+test string-4.21.$noComp {string last, corner case} -body {
run {string last a aaa -1}
-} {-1}
+} -result {-1}
test string-4.22.$noComp {string last, corner case} {
run {string last a aaa end-5}
} {-1}
@@ -473,9 +473,9 @@ test string-5.10.$noComp {string index, unicode} {
test string-5.11.$noComp {string index, unicode} {
run {string index abc\u7266d 3}
} \u7266
-test string-5.12.$noComp {string index, unicode over char length, under byte length} {
+test string-5.12.$noComp {string index, unicode over char length, under byte length} -body {
run {string index \334\374\334\374 6}
-} {}
+} -result {}
test string-5.13.$noComp {string index, bytearray object} {
run {string index [binary format a5 fuz] 0}
} f
@@ -499,15 +499,15 @@ test string-5.17.$noComp {string index, bad integer} -body {
test string-5.18.$noComp {string index, bad integer} -body {
list [catch {run {string index "abc" end-0o0289}} msg] $msg
} -match glob -result {1 {*}}
-test string-5.19.$noComp {string index, bytearray object out of bounds} {
+test string-5.19.$noComp {string index, bytearray object out of bounds} -body {
run {string index [binary format I* {0x50515253 0x52}] -1}
-} {}
-test string-5.20.$noComp {string index, bytearray object out of bounds} {
+} -result {}
+test string-5.20.$noComp {string index, bytearray object out of bounds} -body {
run {string index [binary format I* {0x50515253 0x52}] 20}
-} {}
-test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} fullutf {
+} -result {}
+test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints fullutf -body {
run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]}
-} [list \U100000 b {}]
+} -result [list \U100000 b {}]
proc largest_int {} {
@@ -1564,9 +1564,9 @@ test string-14.4.$noComp {string replace} {
test string-14.5.$noComp {string replace} {
run {string replace abcdefghijklmnop 2 14}
} {abp}
-test string-14.6.$noComp {string replace} {
+test string-14.6.$noComp {string replace} -body {
run {string replace abcdefghijklmnop 7 1000}
-} {abcdefg}
+} -result {abcdefg}
test string-14.7.$noComp {string replace} {
run {string replace abcdefghijklmnop 10 end}
} {abcdefghij}
@@ -1579,9 +1579,9 @@ test string-14.9.$noComp {string replace} {
test string-14.10.$noComp {string replace} {
run {string replace abcdefghijklmnop -3 -2}
} {abcdefghijklmnop}
-test string-14.11.$noComp {string replace} {
+test string-14.11.$noComp {string replace} -body {
run {string replace abcdefghijklmnop 1000 1010}
-} {abcdefghijklmnop}
+} -result {abcdefghijklmnop}
test string-14.12.$noComp {string replace} {
run {string replace abcdefghijklmnop -100 end}
} {}
@@ -1814,88 +1814,88 @@ test string-20.6.$noComp {string trimright, unicode default} {
run {string trimright ABC\u1361\x85\x00\xA0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000}
} ABC\u1361
-test string-21.1.$noComp {string wordend} {
+test string-21.1.$noComp {string wordend} -body {
list [catch {run {string wordend a}} msg] $msg
-} {1 {wrong # args: should be "string wordend string index"}}
-test string-21.2.$noComp {string wordend} {
+} -result {1 {wrong # args: should be "string wordend string index"}}
+test string-21.2.$noComp {string wordend} -body {
list [catch {run {string wordend a b c}} msg] $msg
-} {1 {wrong # args: should be "string wordend string index"}}
-test string-21.3.$noComp {string wordend} {
+} -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
-} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-21.4.$noComp {string wordend} {
+} -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}
-} 3
-test string-21.5.$noComp {string wordend} {
+} -result 3
+test string-21.5.$noComp {string wordend} -body {
run {string wordend abc. 100}
-} 4
-test string-21.6.$noComp {string wordend} {
+} -result 4
+test string-21.6.$noComp {string wordend} -body {
run {string wordend "word_one two three" 2}
-} 8
-test string-21.7.$noComp {string wordend} {
+} -result 8
+test string-21.7.$noComp {string wordend} -body {
run {string wordend "one .&# three" 5}
-} 6
-test string-21.8.$noComp {string wordend} {
+} -result 6
+test string-21.8.$noComp {string wordend} -body {
run {string worde "x.y" 0}
-} 1
-test string-21.9.$noComp {string wordend} {
+} -result 1
+test string-21.9.$noComp {string wordend} -body {
run {string worde "x.y" end-1}
-} 2
-test string-21.10.$noComp {string wordend, unicode} {
+} -result 2
+test string-21.10.$noComp {string wordend, unicode} -body {
run {string wordend "xyz\xC7de fg" 0}
-} 6
-test string-21.11.$noComp {string wordend, unicode} {
+} -result 6
+test string-21.11.$noComp {string wordend, unicode} -body {
run {string wordend "xyz\uC700de fg" 0}
-} 6
-test string-21.12.$noComp {string wordend, unicode} {
+} -result 6
+test string-21.12.$noComp {string wordend, unicode} -body {
run {string wordend "xyz\u203Fde fg" 0}
-} 6
-test string-21.13.$noComp {string wordend, unicode} {
+} -result 6
+test string-21.13.$noComp {string wordend, unicode} -body {
run {string wordend "xyz\u2045de fg" 0}
-} 3
-test string-21.14.$noComp {string wordend, unicode} {
+} -result 3
+test string-21.14.$noComp {string wordend, unicode} -body {
run {string wordend "\uC700\uC700 abc" 8}
-} 6
+} -result 6
-test string-22.1.$noComp {string wordstart} {
+test string-22.1.$noComp {string wordstart} -body {
list [catch {run {string word a}} msg] $msg
-} {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-test string-22.2.$noComp {string wordstart} {
+} -result {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
+test string-22.2.$noComp {string wordstart} -body {
list [catch {run {string wordstart a}} msg] $msg
-} {1 {wrong # args: should be "string wordstart string index"}}
-test string-22.3.$noComp {string wordstart} {
+} -result {1 {wrong # args: should be "string wordstart string index"}}
+test string-22.3.$noComp {string wordstart} -body {
list [catch {run {string wordstart a b c}} msg] $msg
-} {1 {wrong # args: should be "string wordstart string index"}}
-test string-22.4.$noComp {string wordstart} {
+} -result {1 {wrong # args: should be "string wordstart string index"}}
+test string-22.4.$noComp {string wordstart} -body {
list [catch {run {string wordstart a gorp}} msg] $msg
-} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-22.5.$noComp {string wordstart} {
+} -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
+test string-22.5.$noComp {string wordstart} -body {
run {string wordstart "one two three_words" 400}
-} 8
-test string-22.6.$noComp {string wordstart} {
+} -result 8
+test string-22.6.$noComp {string wordstart} -body {
run {string wordstart "one two three_words" 2}
-} 0
-test string-22.7.$noComp {string wordstart} {
+} -result 0
+test string-22.7.$noComp {string wordstart} -body {
run {string wordstart "one two three_words" -2}
-} 0
-test string-22.8.$noComp {string wordstart} {
+} -result 0
+test string-22.8.$noComp {string wordstart} -body {
run {string wordstart "one .*&^ three" 6}
-} 6
-test string-22.9.$noComp {string wordstart} {
+} -result 6
+test string-22.9.$noComp {string wordstart} -body {
run {string wordstart "one two three" 4}
-} 4
-test string-22.10.$noComp {string wordstart} {
+} -result 4
+test string-22.10.$noComp {string wordstart} -body {
run {string wordstart "one two three" end-5}
-} 7
-test string-22.11.$noComp {string wordstart, unicode} {
+} -result 7
+test string-22.11.$noComp {string wordstart, unicode} -body {
run {string wordstart "one tw\xC7o three" 7}
-} 4
-test string-22.12.$noComp {string wordstart, unicode} {
+} -result 4
+test string-22.12.$noComp {string wordstart, unicode} -body {
run {string wordstart "ab\uC700\uC700 cdef ghi" 12}
-} 10
-test string-22.13.$noComp {string wordstart, unicode} {
+} -result 10
+test string-22.13.$noComp {string wordstart, unicode} -body {
run {string wordstart "\uC700\uC700 abc" 8}
-} 3
+} -result 3
test string-23.0.$noComp {string is boolean, Bug 1187123} testindexobj {
set x 5
diff --git a/tests/util.test b/tests/util.test
index 8f42047..49fbebf 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -653,16 +653,16 @@ test util-9.43 {Tcl_GetIntForIndex} -body {
test util-9.44 {Tcl_GetIntForIndex} -body {
string index a 0+1000000000000
} -result {}
-test util-9.45 {Tcl_GetIntForIndex} {
+test util-9.45 {Tcl_GetIntForIndex} -body {
string index abcd end+2305843009213693950
-} {}
-test util-9.46 {Tcl_GetIntForIndex} {
+} -result {}
+test util-9.46 {Tcl_GetIntForIndex} -body {
string index abcd end+4294967294
-} {}
+} -result {}
# TIP 502
-test util-9.47 {Tcl_GetIntForIndex} {
+test util-9.47 {Tcl_GetIntForIndex} -body {
string index abcd 0x10000000000000000
-} {}
+} -result {}
test util-9.48 {Tcl_GetIntForIndex} {
string index abcd -0x10000000000000000
} {}
@@ -684,18 +684,18 @@ test util-9.53 {Tcl_GetIntForIndex} -body {
test util-9.54 {Tcl_GetIntForIndex} {
string index abcd end-0x10000000000000000
} {}
-test util-9.55 {Tcl_GetIntForIndex} {
+test util-9.55 {Tcl_GetIntForIndex} -body {
string index abcd end+0x10000000000000000
-} {}
-test util-9.56 {Tcl_GetIntForIndex} {
+} -result {}
+test util-9.56 {Tcl_GetIntForIndex} -body {
string index abcd end--0x10000000000000000
-} {}
+} -result {}
test util-9.57 {Tcl_GetIntForIndex} {
string index abcd end+-0x10000000000000000
} {}
-test util-9.58 {Tcl_GetIntForIndex} {
+test util-9.58 {Tcl_GetIntForIndex} -body {
string index abcd end--0x8000000000000000
-} {}
+} -result {}
test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
convertDouble 0x0000000000000000
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 5524850..fe99416 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -625,6 +625,16 @@ TclpSetVariables(
*----------------------------------------------------------------------
*/
+#if defined(_WIN32)
+# define tenviron _wenviron
+# define tenviron2utfdstr(tenvstr, len, dstr) \
+ Tcl_WinTCharToUtf((TCHAR *)tenvstr, len, dstr)
+#else
+# define tenviron environ
+# define tenviron2utfdstr(tenvstr, len, dstr) \
+ Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr)
+#endif
+
size_t
TclpFindVariable(
const char *name, /* Name of desired environment variable
@@ -649,14 +659,16 @@ TclpFindVariable(
Tcl_UtfToUpper(nameUpper);
Tcl_DStringInit(&envString);
- for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
+ for (i = 0, env = (const char *)tenviron[i];
+ env != NULL;
+ i++, env = (const char *)tenviron[i]) {
/*
* Chop the env string off after the equal sign, then Convert the name
* to all upper case, so we do not have to convert all the characters
* after the equal sign.
*/
- envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
+ envUpper = tenviron2utfdstr(env, -1, &envString);
p1 = strchr(envUpper, '=');
if (p1 == NULL) {
continue;
generated by cgit v0.12 at 2025-11-25 21:56:48 (GMT)