summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCmdAH.c76
-rw-r--r--tests/encoding.test28
2 files changed, 81 insertions, 23 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 29edf2a..b152369 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -419,37 +419,58 @@ EncodingConvertfromObjCmd(
#else
int flags = TCL_ENCODING_NOCOMPLAIN;
#endif
- size_t result;
+ size_t result, errorPosition = 0;
+ Tcl_Obj *failVarObj = NULL;
+ /*
+ * Decode parameters:
+ * Possible combinations:
+ * 1) data -> objc = 2
+ * 2) encoding data -> objc = 3
+ * 3) -nocomplain data -> objc = 3 (8.7)
+ * 4) -nocomplain encoding data -> objc = 4 (8.7)
+ * 5) -failindex val data -> objc = 4
+ * 6) -failindex val encoding data -> objc = 5
+ */
if (objc == 2) {
encoding = Tcl_GetEncoding(interp, NULL);
data = objv[1];
- } else if ((unsigned)(objc - 2) < 3) {
+ } else if (objc > 2 && objc < 6) {
+ int objcUnprocessed = objc;
data = objv[objc - 1];
bytesPtr = Tcl_GetString(objv[1]);
if (bytesPtr[0] == '-' && bytesPtr[1] == 'n'
&& !strncmp(bytesPtr, "-nocomplain", strlen(bytesPtr))) {
flags = TCL_ENCODING_NOCOMPLAIN;
- } else if (objc < 4) {
- if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
- return TCL_ERROR;
+ objcUnprocessed--;
+ } else if (bytesPtr[0] == '-' && bytesPtr[1] == 'f'
+ && !strncmp(bytesPtr, "-failindex", strlen(bytesPtr))) {
+ /* at least two additional arguments needed */
+ if (objc < 4) {
+ goto encConvFromError;
}
- goto encConvFromOK;
- } else {
- goto encConvFromError;
+ failVarObj = objv[2];
+ flags = TCL_ENCODING_STOPONERROR;
+ objcUnprocessed -= 2;
}
- if (objc < 4) {
- encoding = Tcl_GetEncoding(interp, NULL);
- } else if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
- return TCL_ERROR;
+ switch (objcUnprocessed) {
+ case 3:
+ if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case 2:
+ encoding = Tcl_GetEncoding(interp, NULL);
+ break;
+ default:
+ goto encConvFromError;
}
} else {
encConvFromError:
- Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?encoding? data");
+ Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain|-failindex var? ?encoding? data");
return TCL_ERROR;
}
-encConvFromOK:
/*
* Convert the string into a byte array in 'ds'
*/
@@ -460,14 +481,25 @@ encConvFromOK:
result = Tcl_ExternalToUtfDStringEx(encoding, bytesPtr, length,
flags, &ds);
if ((flags & TCL_ENCODING_STOPONERROR) && (result != (size_t)-1)) {
- char buf[TCL_INTEGER_SPACE];
- sprintf(buf, "%" TCL_Z_MODIFIER "u", result);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected byte sequence starting at index %"
- TCL_Z_MODIFIER "u: '\\x%X'", result, UCHAR(bytesPtr[result])));
- Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
- buf, NULL);
- Tcl_DStringFree(&ds);
- return TCL_ERROR;
+ 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) {
+ return TCL_ERROR;
+ }
+ } else {
+ char buf[TCL_INTEGER_SPACE];
+ sprintf(buf, "%" TCL_Z_MODIFIER "u", result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected byte sequence starting at index %"
+ TCL_Z_MODIFIER "u: '\\x%X'", result, UCHAR(bytesPtr[result])));
+ Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
+ buf, NULL);
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ } else if (failVarObj != NULL) {
+ if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(-1), TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
}
/*
diff --git a/tests/encoding.test b/tests/encoding.test
index daf91fa..7a1e4e7 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -669,10 +669,36 @@ test encoding-24.21 {Parse with -nocomplain but without providing encoding} {
} 1
test encoding-24.22 {Syntax error, two encodings} -body {
encoding convertfrom iso8859-1 utf-8 "ZX\uD800"
-} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?encoding? data"}
+} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain|-failindex var? ?encoding? data"}
test encoding-24.23 {Syntax error, two encodings} -body {
encoding convertto iso8859-1 utf-8 "ZX\uD800"
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?encoding? data"}
+test encoding-24.24 {Syntax error, no parameter} -body {
+ encoding convertfrom
+} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain|-failindex var? ?encoding? data"}
+test encoding-24.25 {Syntax error, -nocomplain and -failindex, no encoding} -body {
+ encoding convertfrom -nocomplain -failindex 2 ABC
+} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain|-failindex var? ?encoding? data"}
+test encoding-24.26 {Syntax error, -failindex and -nocomplain, no encoding} -body {
+ encoding convertfrom -failindex 2 -nocomplain ABC
+} -returnCodes 1 -result {unknown encoding "-nocomplain"}
+test encoding-24.27 {Syntax error, -nocomplain and -failindex, encoding} -body {
+ encoding convertfrom -nocomplain -failindex 2 utf-8 ABC
+} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain|-failindex var? ?encoding? data"}
+test encoding-24.28 {Syntax error, -failindex and -nocomplain, encoding} -body {
+ encoding convertfrom -failindex 2 -nocomplain utf-8 ABC
+} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain|-failindex var? ?encoding? data"}
+test encoding-24.29 {Syntax error, -failindex with no var, no encoding} -body {
+ encoding convertfrom -failindex ABC
+} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain|-failindex var? ?encoding? data"}
+test encoding-24.30 {convertrom -failindex with correct data} -body {
+ encoding convertfrom -failindex test ABC
+ set test
+} -returnCodes 0 -result -1
+test encoding-24.31 {convertrom -failindex with incomplete utf8} -body {
+ set res [encoding convertfrom -failindex test A\xc3]
+ lappend res $test
+} -returnCodes 0 -result {A 1}
file delete [file join [temporaryDirectory] iso2022.txt]
generated by cgit v0.12 at 2024-11-16 08:17:44 (GMT)