summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authoroehhar <harald.oehlmann@elmicron.de>2022-03-17 14:12:07 (GMT)
committeroehhar <harald.oehlmann@elmicron.de>2022-03-17 14:12:07 (GMT)
commit6ab9fddde8b511b128c02e0c51a78c77019ca70b (patch)
tree2993a434811706c37cf3255246bc55e49e0d0f49
parent190439cf96a3f4399b008c47251c4f9956c61878 (diff)
parent7056164cd356e6aed9a9290471a7029c35a606f5 (diff)
downloadtcl-6ab9fddde8b511b128c02e0c51a78c77019ca70b.zip
tcl-6ab9fddde8b511b128c02e0c51a78c77019ca70b.tar.gz
tcl-6ab9fddde8b511b128c02e0c51a78c77019ca70b.tar.bz2
merge main
-rw-r--r--generic/tcl.decls4
-rw-r--r--generic/tclCmdAH.c6
-rw-r--r--generic/tclDecls.h8
-rw-r--r--generic/tclEncoding.c12
-rw-r--r--tests/chanio.test12
-rw-r--r--tests/encoding.test16
-rw-r--r--tests/http.test6
-rw-r--r--tests/io.test16
-rw-r--r--tests/main.test4
-rw-r--r--tests/source.test6
10 files changed, 43 insertions, 47 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index f568eb8..5a03bd2 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2500,11 +2500,11 @@ declare 657 {
}
declare 658 {
size_t Tcl_ExternalToUtfDStringEx(Tcl_Encoding encoding,
- const char *src, int srcLen, int flags, Tcl_DString *dsPtr)
+ const char *src, size_t srcLen, int flags, Tcl_DString *dsPtr)
}
declare 659 {
size_t Tcl_UtfToExternalDStringEx(Tcl_Encoding encoding,
- const char *src, int srcLen, int flags, Tcl_DString *dsPtr)
+ const char *src, size_t srcLen, int flags, Tcl_DString *dsPtr)
}
# TIP #511
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 9772c56..37da762 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -474,13 +474,13 @@ EncodingConvertfromObjCmd(
/*
* Convert the string into a byte array in 'ds'
*/
- bytesPtr = (char *) TclGetBytesFromObj(interp, data, &length);
+ bytesPtr = (char *) Tcl_GetBytesFromObj(interp, data, &length);
if (bytesPtr == NULL) {
return TCL_ERROR;
}
result = Tcl_ExternalToUtfDStringEx(encoding, bytesPtr, length,
flags, &ds);
- if ((flags & TCL_ENCODING_STOPONERROR) && (result != (size_t)-1)) {
+ if ((flags & TCL_ENCODING_STOPONERROR) && (result != TCL_INDEX_NONE)) {
if (failVarObj != NULL) {
/* I hope, wide int will cover size_t data type */
if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(result), TCL_LEAVE_ERR_MSG) == NULL) {
@@ -587,7 +587,7 @@ encConvToOK:
stringPtr = Tcl_GetStringFromObj(data, &length);
result = Tcl_UtfToExternalDStringEx(encoding, stringPtr, length,
flags, &ds);
- if ((flags & TCL_ENCODING_STOPONERROR) && (result != (size_t)-1)) {
+ if ((flags & TCL_ENCODING_STOPONERROR) && (result != TCL_INDEX_NONE)) {
size_t pos = Tcl_NumUtfChars(stringPtr, result);
int ucs4;
char buf[TCL_INTEGER_SPACE];
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index b14de92..14a21b9 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1756,11 +1756,11 @@ EXTERN const char * Tcl_UtfPrev(const char *src, const char *start);
EXTERN int Tcl_UniCharIsUnicode(int ch);
/* 658 */
EXTERN size_t Tcl_ExternalToUtfDStringEx(Tcl_Encoding encoding,
- const char *src, int srcLen, int flags,
+ const char *src, size_t srcLen, int flags,
Tcl_DString *dsPtr);
/* 659 */
EXTERN size_t Tcl_UtfToExternalDStringEx(Tcl_Encoding encoding,
- const char *src, int srcLen, int flags,
+ const char *src, size_t srcLen, int flags,
Tcl_DString *dsPtr);
/* 660 */
EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async,
@@ -2443,8 +2443,8 @@ typedef struct TclStubs {
const char * (*tcl_UtfNext) (const char *src); /* 655 */
const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */
int (*tcl_UniCharIsUnicode) (int ch); /* 657 */
- size_t (*tcl_ExternalToUtfDStringEx) (Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_DString *dsPtr); /* 658 */
- size_t (*tcl_UtfToExternalDStringEx) (Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_DString *dsPtr); /* 659 */
+ size_t (*tcl_ExternalToUtfDStringEx) (Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_DString *dsPtr); /* 658 */
+ size_t (*tcl_UtfToExternalDStringEx) (Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_DString *dsPtr); /* 659 */
int (*tcl_AsyncMarkFromSignal) (Tcl_AsyncHandler async, int sigNumber); /* 660 */
void (*reserved661)(void);
void (*reserved662)(void);
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 2bb01fb..fd2337b 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1117,7 +1117,7 @@ Tcl_ExternalToUtfDStringEx(
Tcl_Encoding encoding, /* The encoding for the source string, or NULL
* for the default system encoding. */
const char *src, /* Source string in specified encoding. */
- int srcLen, /* Source string length in bytes, or < 0 for
+ size_t srcLen, /* Source string length in bytes, or TCL_INDEX_NONE for
* encoding-specific string length. */
int flags, /* Conversion control flags. */
Tcl_DString *dstPtr) /* Uninitialized or free DString in which the
@@ -1126,8 +1126,8 @@ Tcl_ExternalToUtfDStringEx(
char *dst;
Tcl_EncodingState state;
const Encoding *encodingPtr;
- size_t dstLen;
int result, soFar, srcRead, dstWrote, dstChars;
+ size_t dstLen;
const char *srcStart = src;
Tcl_DStringInit(dstPtr);
@@ -1158,7 +1158,7 @@ Tcl_ExternalToUtfDStringEx(
src += srcRead;
if (result != TCL_CONVERT_NOSPACE) {
Tcl_DStringSetLength(dstPtr, soFar);
- return (result == TCL_OK) ? (size_t)-1 : (size_t)(src - srcStart);
+ return (result == TCL_OK) ? TCL_INDEX_NONE : (size_t)(src - srcStart);
}
flags &= ~TCL_ENCODING_START;
srcLen -= srcRead;
@@ -1357,7 +1357,7 @@ Tcl_UtfToExternalDStringEx(
Tcl_Encoding encoding, /* The encoding for the converted string, or
* NULL for the default system encoding. */
const char *src, /* Source string in UTF-8. */
- int srcLen, /* Source string length in bytes, or < 0 for
+ size_t srcLen, /* Source string length in bytes, or < 0 for
* strlen(). */
int flags, /* Conversion control flags. */
Tcl_DString *dstPtr) /* Uninitialized or free DString in which the
@@ -1366,9 +1366,9 @@ Tcl_UtfToExternalDStringEx(
char *dst;
Tcl_EncodingState state;
const Encoding *encodingPtr;
- size_t dstLen;
int result, soFar, srcRead, dstWrote, dstChars;
const char *srcStart = src;
+ size_t dstLen;
Tcl_DStringInit(dstPtr);
dst = Tcl_DStringValue(dstPtr);
@@ -1397,7 +1397,7 @@ Tcl_UtfToExternalDStringEx(
while (i >= soFar) {
Tcl_DStringSetLength(dstPtr, i--);
}
- return (result == TCL_OK) ? (size_t)-1 : (size_t)(src - srcStart);
+ return (result == TCL_OK) ? TCL_INDEX_NONE : (size_t)(src - srcStart);
}
flags &= ~TCL_ENCODING_START;
diff --git a/tests/chanio.test b/tests/chanio.test
index 578dc9f..11a4e74 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -249,7 +249,7 @@ test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -bod
} -cleanup {
chan close $f
} -result "\r\n12"
-test chan-io-3.4 {WriteChars: loop over stage buffer} deprecated {
+test chan-io-3.4 {WriteChars: loop over stage buffer} -body {
# stage buffer maps to more than can be queued at once.
set f [open $path(test1) w]
chan configure $f -encoding jis0208 -buffersize 16
@@ -257,8 +257,8 @@ test chan-io-3.4 {WriteChars: loop over stage buffer} deprecated {
set x [list [contents $path(test1)]]
chan close $f
lappend x [contents $path(test1)]
-} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
-test chan-io-3.5 {WriteChars: saved != 0} deprecated {
+} -errorCode {POSIX EILSEQ {illegal byte sequence}} -match glob -result {error writing "*": illegal byte sequence}
+test chan-io-3.5 {WriteChars: saved != 0} -body {
# Bytes produced by UtfToExternal from end of last channel buffer had to
# be moved to beginning of next channel buffer to preserve requested
# buffersize.
@@ -268,7 +268,7 @@ test chan-io-3.5 {WriteChars: saved != 0} deprecated {
set x [list [contents $path(test1)]]
chan close $f
lappend x [contents $path(test1)]
-} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+} -errorCode {POSIX EILSEQ {illegal byte sequence}} -match glob -result {error writing "*": illegal byte sequence}
test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# One incomplete UTF-8 character at end of staging buffer. Backup in src
# to the beginning of that UTF-8 character and try again.
@@ -285,7 +285,7 @@ test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
chan close $f
lappend x [contents $path(test1)]
} [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
-test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} deprecated {
+test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body {
# When translating UTF-8 to external, the produced bytes went past end of
# the channel buffer. This is done on purpose - we then truncate the bytes
# at the end of the partial character to preserve the requested blocksize
@@ -297,7 +297,7 @@ test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} deprecated {
set x [list [contents $path(test1)]]
chan close $f
lappend x [contents $path(test1)]
-} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+} -errorCode {POSIX EILSEQ {illegal byte sequence}} -match glob -result {error writing "*": illegal byte sequence}
test chan-io-3.8 {WriteChars: reset sawLF after each buffer} {
set f [open $path(test1) w]
chan configure $f -encoding ascii -buffering line -translation lf \
diff --git a/tests/encoding.test b/tests/encoding.test
index 9bd0e6b..1556d24 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -22,8 +22,6 @@ catch {
package require -exact tcl::test [info patchlevel]
}
-testConstraint deprecated [expr {![info exists tcl_precision]}]
-
proc toutf {args} {
variable x
lappend x "toutf $args"
@@ -637,28 +635,28 @@ test encoding-24.10 {Parse valid or invalid utf-8} {
test encoding-24.11 {Parse valid or invalid utf-8} {
string length [encoding convertfrom -nocomplain utf-8 "\xEF\xBF\xBF"]
} 1
-test encoding-24.12 {Parse valid or invalid utf-8} -constraints deprecated -body {
+test encoding-24.12 {Parse valid or invalid utf-8} -body {
encoding convertfrom utf-8 "\xC0\x81"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
-test encoding-24.13 {Parse valid or invalid utf-8} -constraints deprecated -body {
+test encoding-24.13 {Parse valid or invalid utf-8} -body {
encoding convertfrom utf-8 "\xC1\xBF"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC1'}
test encoding-24.14 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xC2\x80"]
} 1
-test encoding-24.15 {Parse valid or invalid utf-8} -constraints deprecated -body {
+test encoding-24.15 {Parse valid or invalid utf-8} -body {
encoding convertfrom utf-8 "Z\xE0\x80"
} -returnCodes 1 -result {unexpected byte sequence starting at index 1: '\xE0'}
-test encoding-24.16 {Parse valid or invalid utf-8} -constraints {testbytestring deprecated} -body {
+test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body {
encoding convertto utf-8 [testbytestring "Z\u4343\x80"]
} -returnCodes 1 -result {expected byte sequence but character 1 was '䍃€' (U+004343)}
-test encoding-24.17 {Parse valid or invalid utf-8} -constraints {testbytestring deprecated} -body {
+test encoding-24.17 {Parse valid or invalid utf-8} -constraints testbytestring -body {
encoding convertto utf-8 [testbytestring "Z\xE0\x80"]
} -result "Z\xC3\xA0\xE2\x82\xAC"
-test encoding-24.18 {Parse valid or invalid utf-8} -constraints {testbytestring deprecated} -body {
+test encoding-24.18 {Parse valid or invalid utf-8} -constraints testbytestring -body {
encoding convertto utf-8 [testbytestring "Z\xE0\x80xxxxxx"]
} -result "Z\xC3\xA0\xE2\x82\xACxxxxxx"
-test encoding-24.19 {Parse valid or invalid utf-8} -constraints deprecated -body {
+test encoding-24.19 {Parse valid or invalid utf-8} -body {
encoding convertto utf-8 "ZX\uD800"
} -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'"
test encoding-24.20 {Parse with -nocomplain but without providing encoding} {
diff --git a/tests/http.test b/tests/http.test
index 93998fe..3b2963e 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -661,16 +661,14 @@ test http-7.3 {http::formatQuery} -setup {
} -cleanup {
http::config -urlencoding $enc
} -result "can't read \"formMap(∈)\": no such element in array"
-test http-7.4 {http::formatQuery} -constraints deprecated -setup {
+test http-7.4 {http::formatQuery} -setup {
set enc [http::config -urlencoding]
} -body {
- # this would be reverting to http <=2.4 behavior w/o errors
- # (unknown chars become '?')
http::config -urlencoding "iso8859-1"
http::mapReply "∈"
} -cleanup {
http::config -urlencoding $enc
-} -result {%3F}
+} -errorCode {TCL ENCODING ILLEGALSEQUENCE 0} -result {unexpected character at index 0: 'U+002208'}
package require tcl::idna 1.0
diff --git a/tests/io.test b/tests/io.test
index 821b11e..9b7a34a 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -268,7 +268,7 @@ test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
close $f
set x
} "\r\n12"
-test io-3.4 {WriteChars: loop over stage buffer} deprecated {
+test io-3.4 {WriteChars: loop over stage buffer} -body {
# stage buffer maps to more than can be queued at once.
set f [open $path(test1) w]
@@ -277,8 +277,8 @@ test io-3.4 {WriteChars: loop over stage buffer} deprecated {
set x [list [contents $path(test1)]]
close $f
lappend x [contents $path(test1)]
-} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
-test io-3.5 {WriteChars: saved != 0} deprecated {
+} -errorCode {POSIX EILSEQ {illegal byte sequence}} -match glob -result {error writing "*": illegal byte sequence}
+test io-3.5 {WriteChars: saved != 0} -body {
# Bytes produced by UtfToExternal from end of last channel buffer
# had to be moved to beginning of next channel buffer to preserve
# requested buffersize.
@@ -289,7 +289,7 @@ test io-3.5 {WriteChars: saved != 0} deprecated {
set x [list [contents $path(test1)]]
close $f
lappend x [contents $path(test1)]
-} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+} -errorCode {POSIX EILSEQ {illegal byte sequence}} -match glob -result {error writing "*": illegal byte sequence}
test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# One incomplete UTF-8 character at end of staging buffer. Backup
# in src to the beginning of that UTF-8 character and try again.
@@ -307,7 +307,7 @@ test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
close $f
lappend x [contents $path(test1)]
} [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
-test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} deprecated {
+test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body {
# When translating UTF-8 to external, the produced bytes went past end
# of the channel buffer. This is done purpose -- we then truncate the
# bytes at the end of the partial character to preserve the requested
@@ -320,7 +320,7 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} deprecated {
set x [list [contents $path(test1)]]
close $f
lappend x [contents $path(test1)]
-} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+} -errorCode {POSIX EILSEQ {illegal byte sequence}} -match glob -result {error writing "*": illegal byte sequence}
test io-3.8 {WriteChars: reset sawLF after each buffer} {
set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffering line -translation lf \
@@ -1532,7 +1532,7 @@ test io-12.8 {ReadChars: multibyte chars split} {
close $f
scan [string index $in end] %c
} 160
-test io-12.9 {ReadChars: multibyte chars split} deprecated {
+test io-12.9 {ReadChars: multibyte chars split} knownBug {
set f [open $path(test1) w]
fconfigure $f -translation binary
puts -nonewline $f [string repeat a 9]\xC2
@@ -1543,7 +1543,7 @@ test io-12.9 {ReadChars: multibyte chars split} deprecated {
close $f
scan [string index $in end] %c
} 194
-test io-12.10 {ReadChars: multibyte chars split} deprecated {
+test io-12.10 {ReadChars: multibyte chars split} knownBug {
set f [open $path(test1) w]
fconfigure $f -translation binary
puts -nonewline $f [string repeat a 9]\xC2
diff --git a/tests/main.test b/tests/main.test
index ef58b6f..4aadd79 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -143,7 +143,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-1.8 {
Tcl_Main: startup script - -encoding option - mismatched encodings
} -constraints {
- stdio deprecated
+ stdio
} -setup {
set script [makeFile {} script]
file delete $script
@@ -153,7 +153,7 @@ namespace eval ::tcl::test::main {
puts -nonewline $f {puts [string equal \u20ac }
puts $f "€]"
close $f
- catch {set f [open "|[list [interpreter] -encoding ascii script]" r]}
+ catch {set f [open "|[list [interpreter] -encoding iso8859-1 script]" r]}
} -body {
read $f
} -cleanup {
diff --git a/tests/source.test b/tests/source.test
index 1b73ca6..98aaee2 100644
--- a/tests/source.test
+++ b/tests/source.test
@@ -275,7 +275,7 @@ test source-7.5 {source -encoding: correct operation} -setup {
removeFile source.file
rename € {}
} -result foo
-test source-7.6 {source -encoding: mismatch encoding error} -constraints deprecated -setup {
+test source-7.6 {source -encoding: mismatch encoding error} -setup {
set sourcefile [makeFile {} source.file]
file delete $sourcefile
set f [open $sourcefile w]
@@ -283,11 +283,11 @@ test source-7.6 {source -encoding: mismatch encoding error} -constraints depreca
puts $f "proc € {} {return foo}"
close $f
} -body {
- source -encoding ascii $sourcefile
+ source -encoding iso8859-1 $sourcefile
} -cleanup {
removeFile source.file
-} -returnCodes error -match glob -result {invalid command name*}
+} -returnCodes error -result {invalid command name "€"}
test source-8.1 {source and coroutine/yield} -setup {
set sourcefile [makeFile {} source.file]