diff options
| -rw-r--r-- | generic/tclCmdAH.c | 89 | ||||
| -rw-r--r-- | tests/cmdAH.test | 119 | ||||
| -rw-r--r-- | tests/encoding.test | 31 |
3 files changed, 180 insertions, 59 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 95ca18a..70767ae 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -426,8 +426,8 @@ EncodingConvertfromObjCmd( * 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) + * 3) -nocomplain data -> objc = 3 + * 4) -nocomplain encoding data -> objc = 4 * 5) -failindex val data -> objc = 4 * 6) -failindex val encoding data -> objc = 5 */ @@ -467,7 +467,7 @@ EncodingConvertfromObjCmd( } } else { encConvFromError: - Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain|-failindex var? ?encoding? data"); + Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-failindex var? ?encoding? data"); return TCL_ERROR; } @@ -544,42 +544,64 @@ EncodingConverttoObjCmd( Tcl_Encoding encoding; /* Encoding to use */ size_t length; /* Length of the string being converted */ const char *stringPtr; /* Pointer to the first byte of the string */ - size_t result; + size_t result, errorPosition = 0; + Tcl_Obj *failVarObj = NULL; #if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED) int flags = TCL_ENCODING_STOPONERROR; #else int flags = TCL_ENCODING_NOCOMPLAIN; #endif + /* + * Decode parameters: + * Possible combinations: + * 1) data -> objc = 2 + * 2) encoding data -> objc = 3 + * 3) -nocomplain data -> objc = 3 + * 4) -nocomplain encoding data -> objc = 4 + * 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]; stringPtr = Tcl_GetString(objv[1]); if (stringPtr[0] == '-' && stringPtr[1] == 'n' && !strncmp(stringPtr, "-nocomplain", strlen(stringPtr))) { flags = TCL_ENCODING_NOCOMPLAIN; - } else if (objc < 4) { - if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) { - return TCL_ERROR; + objcUnprocessed--; + } else if (stringPtr[0] == '-' && stringPtr[1] == 'f' + && !strncmp(stringPtr, "-failindex", strlen(stringPtr))) { + /* at least two additional arguments needed */ + if (objc < 4) { + goto encConvToError; } - goto encConvToOK; - } else { - goto encConvToError; + 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 encConvToError; } } else { encConvToError: - Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?encoding? data"); + Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-failindex var? ?encoding? data"); return TCL_ERROR; } -encConvToOK: /* * Convert the string to a byte array in 'ds' */ @@ -588,17 +610,28 @@ encConvToOK: result = Tcl_UtfToExternalDStringEx(encoding, stringPtr, length, flags, &ds); if ((flags & TCL_ENCODING_STOPONERROR) && (result != (size_t)-1)) { - size_t pos = Tcl_NumUtfChars(stringPtr, result); - int ucs4; - char buf[TCL_INTEGER_SPACE]; - TclUtfToUCS4(&stringPtr[result], &ucs4); - sprintf(buf, "%" TCL_Z_MODIFIER "u", result); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected character at index %" - TCL_Z_MODIFIER "u: 'U+%06X'", pos, ucs4)); - 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 { + size_t pos = Tcl_NumUtfChars(stringPtr, result); + int ucs4; + char buf[TCL_INTEGER_SPACE]; + TclUtfToUCS4(&stringPtr[result], &ucs4); + sprintf(buf, "%" TCL_Z_MODIFIER "u", result); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected character at index %" + TCL_Z_MODIFIER "u: 'U+%06X'", pos, ucs4)); + 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; + } } Tcl_SetObjResult(interp, Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds), diff --git a/tests/cmdAH.test b/tests/cmdAH.test index d7be68b..facf67d 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -172,7 +172,7 @@ test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body { } -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system} test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding convertto -} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?encoding? data"} +} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"} test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding convertto foo bar } -result {unknown encoding "foo"} @@ -194,7 +194,7 @@ test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup { } -result 8C test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding convertfrom -} -result {wrong # args: should be "encoding convertfrom ?-nocomplain|-failindex var? ?encoding? data"} +} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding convertfrom foo bar } -result {unknown encoding "foo"} @@ -229,6 +229,121 @@ test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup { encoding system $system } -result iso8859-1 +test encoding-4.14.1 {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-4.14.2 {Syntax error, -nocomplain and -failindex, no encoding} -body { + encoding convertto -nocomplain -failindex 2 ABC +} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"} +test encoding-4.15.1 {Syntax error, -failindex and -nocomplain, no encoding} -body { + encoding convertfrom -failindex 2 -nocomplain ABC +} -returnCodes 1 -result {unknown encoding "-nocomplain"} +test encoding-4.15.2 {Syntax error, -failindex and -nocomplain, no encoding} -body { + encoding convertto -failindex 2 -nocomplain ABC +} -returnCodes 1 -result {unknown encoding "-nocomplain"} +test encoding-4.16.1 {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-4.16.2 {Syntax error, -nocomplain and -failindex, encoding} -body { + encoding convertto -nocomplain -failindex 2 utf-8 ABC +} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"} +test encoding-4.17.1 {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-4.17.2 {Syntax error, -failindex and -nocomplain, encoding} -body { + encoding convertto -failindex 2 -nocomplain utf-8 ABC +} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"} +test encoding-4.18.1 {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-4.18.2 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup { + proc encoding_test {} { + encoding convertfrom -failindex ABC + } +} -body { + # Compile and execute + encoding_test +} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} -cleanup { + rename encoding_test "" +} +test encoding-4.18.3 {Syntax error, -failindex with no var, no encoding} -body { + encoding convertto -failindex ABC +} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"} +test encoding-4.18.4 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup { + proc encoding_test {} { + encoding convertto -failindex ABC + } +} -body { + # Compile and execute + encoding_test +} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"} -cleanup { + rename encoding_test "" +} +test encoding-4.19.1 {convertrom -failindex with correct data} -body { + encoding convertfrom -failindex test ABC + set test +} -returnCodes 0 -result -1 +test encoding-4.19.2 {convertrom -failindex with correct data (byt compiled)} -setup { + proc encoding_test {} { + encoding convertfrom -failindex test ABC + set test + } +} -body { + # Compile and execute + encoding_test +} -returnCodes 0 -result -1 -cleanup { + rename encoding_test "" +} +test encoding-4.19.3 {convertrom -failindex with correct data} -body { + encoding convertto -failindex test ABC + set test +} -returnCodes 0 -result -1 +test encoding-4.19.4 {convertrom -failindex with correct data (byt compiled)} -setup { + proc encoding_test {} { + encoding convertto -failindex test ABC + set test + } +} -body { + # Compile and execute + encoding_test +} -returnCodes 0 -result -1 -cleanup { + rename encoding_test "" +} +test encoding-4.20.1 {convertrom -failindex with incomplete utf8} -body { + set x [encoding convertfrom -failindex i utf-8 A\xc3] + binary scan $x H* y + list $y $i +} -returnCodes 0 -result {41 1} +test encoding-4.20.2 {convertrom -failindex with incomplete utf8 (byte compiled)} -setup { + proc encoding_test {} { + set x [encoding convertfrom -failindex i utf-8 A\xc3] + binary scan $x H* y + list $y $i + } +} -body { + # Compile and execute + encoding_test +} -returnCodes 0 -result {41 1} -cleanup { + rename encoding_test "" +} +test encoding-4.21.1 {convertto -failindex with wrong character} -body { + set x [encoding convertto -failindex i iso8859-1 A\u0141] + binary scan $x H* y + list $y $i +} -returnCodes 0 -result {41 1} +test encoding-4.20.2 {convertto -failindex with wrong character (byte compiled)} -setup { + proc encoding_test {} { + set x [encoding convertto -failindex i iso8859-1 A\u0141] + binary scan $x H* y + list $y $i + } +} -body { + # Compile and execute + encoding_test +} -returnCodes 0 -result {41 1} -cleanup { + rename encoding_test "" +} + test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body { file } -result {wrong # args: should be "file subcommand ?arg ...?"} diff --git a/tests/encoding.test b/tests/encoding.test index 061bc11..5c06b38 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -667,37 +667,10 @@ 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|-failindex var? ?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 x [encoding convertfrom -failindex i utf-8 A\xc3] - binary scan $x H* y - list $y $i -} -returnCodes 0 -result {41 1} +} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"} file delete [file join [temporaryDirectory] iso2022.txt] |