From 86876436a44b247ec6423fbead92b7c3ce8a2032 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 5 Aug 2011 15:23:55 +0000 Subject: Use Tcl_PrintfObj to generate more (complex) error messages. --- generic/tclAssembly.c | 7 ++----- generic/tclBasic.c | 8 ++------ generic/tclFileName.c | 14 +++++++------- generic/tclIO.c | 9 +++------ generic/tclIORChan.c | 43 ++++++++++++++++++------------------------- generic/tclIORTrans.c | 36 +++++++++++++++--------------------- generic/tclObj.c | 27 +++++++++------------------ generic/tclProc.c | 9 ++++----- generic/tclStrToD.c | 6 ++---- tests/ioTrans.test | 2 +- 10 files changed, 63 insertions(+), 98 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index eca934f..f45ae07 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -2292,15 +2292,12 @@ CheckNamespaceQualifiers( const char* name, /* Variable name to check */ int nameLen) /* Length of the variable */ { - Tcl_Obj* result; /* Error message */ const char* p; for (p = name; p+2 < name+nameLen; p++) { if ((*p == ':') && (p[1] == ':')) { - result = Tcl_NewStringObj("variable \"", -1); - Tcl_AppendToObj(result, name, -1); - Tcl_AppendToObj(result, "\" is not local", -1); - Tcl_SetObjResult(interp, result); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "variable \"%s\" is not local", name)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL); return TCL_ERROR; } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c46510c..a44d736 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3645,12 +3645,8 @@ Tcl_GetMathFuncInfo( */ if (cmdPtr == NULL) { - Tcl_Obj *message; - - TclNewLiteralStringObj(message, "unknown math function \""); - Tcl_AppendToObj(message, name, -1); - Tcl_AppendToObj(message, "\"", 1); - Tcl_SetObjResult(interp, message); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown math function \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL); *numArgsPtr = -1; *argTypesPtr = NULL; diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 05ecb04..8ed6f96 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1210,7 +1210,7 @@ Tcl_GlobObjCmd( int index, i, globFlags, length, join, dir, result; char *string; const char *separators; - Tcl_Obj *typePtr, *resultPtr, *look; + Tcl_Obj *typePtr, *look; Tcl_Obj *pathOrDir = NULL; Tcl_DString prefix; static const char *const options[] = { @@ -1497,8 +1497,8 @@ Tcl_GlobObjCmd( } else { Tcl_Obj *item; - if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) && - (len == 3)) { + if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) + && (len == 3)) { Tcl_ListObjIndex(interp, look, 0, &item); if (!strcmp("macintosh", Tcl_GetString(item))) { Tcl_ListObjIndex(interp, look, 1, &item); @@ -1528,10 +1528,9 @@ Tcl_GlobObjCmd( */ badTypesArg: - TclNewObj(resultPtr); - Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1); - Tcl_AppendObjToObj(resultPtr, look); - Tcl_SetObjResult(interp, resultPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument to \"-types\": %s", + Tcl_GetString(look))); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL); result = TCL_ERROR; join = 0; @@ -1624,6 +1623,7 @@ Tcl_GlobObjCmd( Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL); } else { const char *sep = ""; + for (i = 0; i < objc; i++) { string = Tcl_GetString(objv[i]); Tcl_AppendResult(interp, sep, string, NULL); diff --git a/generic/tclIO.c b/generic/tclIO.c index c7fab6c..78c1dc0 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2095,12 +2095,9 @@ Tcl_GetChannelHandle( chanPtr = ((Channel *) chan)->state->bottomChanPtr; if (!chanPtr->typePtr->getHandleProc) { - Tcl_Obj *err; - - TclNewLiteralStringObj(err, "channel \""); - Tcl_AppendToObj(err, Tcl_GetChannelName(chan), -1); - Tcl_AppendToObj(err, "\" does not support OS handles", -1); - Tcl_SetChannelError(chan, err); + Tcl_SetChannelError(chan, Tcl_ObjPrintf( + "channel \"%s\" does not support OS handles", + Tcl_GetChannelName(chan))); return TCL_ERROR; } result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction, diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 683e2e4..9ba42ef 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -605,11 +605,9 @@ TclChanCreateObjCmd( */ if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { - TclNewLiteralStringObj(err, "chan handler \""); - Tcl_AppendObjToObj(err, cmdObj); - Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1); - Tcl_AppendObjToObj(err, resObj); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s initialize\" returned non-list: %s", + Tcl_GetString(cmdObj), Tcl_GetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } @@ -633,42 +631,37 @@ TclChanCreateObjCmd( Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { - TclNewLiteralStringObj(err, "chan handler \""); - Tcl_AppendObjToObj(err, cmdObj); - Tcl_AppendToObj(err, "\" does not support all required methods", -1); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" does not support all required methods", + Tcl_GetString(cmdObj))); goto error; } if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) { - TclNewLiteralStringObj(err, "chan handler \""); - Tcl_AppendObjToObj(err, cmdObj); - Tcl_AppendToObj(err, "\" lacks a \"read\" method", -1); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" lacks a \"read\" method", + Tcl_GetString(cmdObj))); goto error; } if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) { - TclNewLiteralStringObj(err, "chan handler \""); - Tcl_AppendObjToObj(err, cmdObj); - Tcl_AppendToObj(err, "\" lacks a \"write\" method", -1); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" lacks a \"write\" method", + Tcl_GetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) { - TclNewLiteralStringObj(err, "chan handler \""); - Tcl_AppendObjToObj(err, cmdObj); - Tcl_AppendToObj(err, "\" supports \"cget\" but not \"cgetall\"", -1); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"cget\" but not \"cgetall\"", + Tcl_GetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) { - TclNewLiteralStringObj(err, "chan handler \""); - Tcl_AppendObjToObj(err, cmdObj); - Tcl_AppendToObj(err, "\" supports \"cgetall\" but not \"cget\"", -1); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"cgetall\" but not \"cget\"", + Tcl_GetString(cmdObj))); goto error; } diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 5bd77b7..272306b 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -601,11 +601,9 @@ TclChanPushObjCmd( */ if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { - TclNewLiteralStringObj(err, "chan handler \""); - Tcl_AppendObjToObj(err, cmdObj); - Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1); - Tcl_AppendObjToObj(err, resObj); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s initialize\" returned non-list: %s", + Tcl_GetString(cmdObj), Tcl_GetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } @@ -629,10 +627,9 @@ TclChanPushObjCmd( Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { - TclNewLiteralStringObj(err, "chan handler \""); - Tcl_AppendObjToObj(err, cmdObj); - Tcl_AppendToObj(err, "\" does not support all required methods", -1); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" does not support all required methods", + Tcl_GetString(cmdObj))); goto error; } @@ -652,10 +649,9 @@ TclChanPushObjCmd( } if (!mode) { - TclNewLiteralStringObj(err, "chan handler \""); - Tcl_AppendObjToObj(err, cmdObj); - Tcl_AppendToObj(err, "\" makes the channel inacessible", -1); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" makes the channel inaccessible", + Tcl_GetString(cmdObj))); goto error; } @@ -664,18 +660,16 @@ TclChanPushObjCmd( */ if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) { - TclNewLiteralStringObj(err, "chan handler \""); - Tcl_AppendObjToObj(err, cmdObj); - Tcl_AppendToObj(err, "\" supports \"drain\" but not \"read\"", -1); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"drain\" but not \"read\"", + Tcl_GetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) { - TclNewLiteralStringObj(err, "chan handler \""); - Tcl_AppendObjToObj(err, cmdObj); - Tcl_AppendToObj(err, "\" supports \"flush\" but not \"write\"", -1); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"flush\" but not \"write\"", + Tcl_GetString(cmdObj))); goto error; } diff --git a/generic/tclObj.c b/generic/tclObj.c index a1316d9..099b67d 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2763,12 +2763,9 @@ Tcl_GetLongFromObj( #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { - Tcl_Obj *msg; - - TclNewLiteralStringObj(msg, "expected integer but got \""); - Tcl_AppendObjToObj(msg, objPtr); - Tcl_AppendToObj(msg, "\"", -1); - Tcl_SetObjResult(interp, msg); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + Tcl_GetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; @@ -3067,12 +3064,9 @@ Tcl_GetWideIntFromObj( } if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { - Tcl_Obj *msg; - - TclNewLiteralStringObj(msg, "expected integer but got \""); - Tcl_AppendObjToObj(msg, objPtr); - Tcl_AppendToObj(msg, "\"", -1); - Tcl_SetObjResult(interp, msg); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + Tcl_GetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; @@ -3401,12 +3395,9 @@ GetBignumFromObj( #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { - Tcl_Obj *msg; - - TclNewLiteralStringObj(msg, "expected integer but got \""); - Tcl_AppendObjToObj(msg, objPtr); - Tcl_AppendToObj(msg, "\"", -1); - Tcl_SetObjResult(interp, msg); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + Tcl_GetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; diff --git a/generic/tclProc.c b/generic/tclProc.c index 48f472f..50cf0f7 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2480,7 +2480,7 @@ SetLambdaFromAny( { Interp *iPtr = (Interp *) interp; const char *name; - Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr; + Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv; int objc, result; Proc *procPtr; @@ -2495,10 +2495,9 @@ SetLambdaFromAny( result = TclListObjGetElements(NULL, objPtr, &objc, &objv); if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { - TclNewLiteralStringObj(errPtr, "can't interpret \""); - Tcl_AppendObjToObj(errPtr, objPtr); - Tcl_AppendToObj(errPtr, "\" as a lambda expression", -1); - Tcl_SetObjResult(interp, errPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't interpret \"%s\" as a lambda expression", + Tcl_GetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL); return TCL_ERROR; } diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 15bff3e..8a961ff 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -1384,11 +1384,9 @@ TclParseNumber( if (status != TCL_OK) { if (interp != NULL) { - Tcl_Obj *msg; + Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"", + expected); - TclNewLiteralStringObj(msg, "expected "); - Tcl_AppendToObj(msg, expected, -1); - Tcl_AppendToObj(msg, " but got \"", -1); Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, ""); Tcl_AppendToObj(msg, "\"", -1); if (state == BAD_OCTAL) { diff --git a/tests/ioTrans.test b/tests/ioTrans.test index 3ea017b..d8defcc 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -207,7 +207,7 @@ test iortrans-2.14 {chan push, initialize failed, bad result, mode/handler misma } -returnCodes error -cleanup { tempdone rename foo {} -} -match glob -result {*makes the channel inacessible} +} -match glob -result {*makes the channel inaccessible} # iortrans-2.15 event/watch methods elimimated, removed these tests. # iortrans-2.16 test iortrans-2.17 {chan push, initialize failed, bad result, drain/read mismatch} -body { -- cgit v0.12