diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2012-08-03 14:24:34 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2012-08-03 14:24:34 (GMT) |
commit | 9721f569eacfc8d7452182fb57bfa2a758f580b7 (patch) | |
tree | 638bb10c1c93ca8531074a657f22bf17d2447bee | |
parent | 4152a1cc08547b251509c18405d318433f5ece2e (diff) | |
download | tcl-9721f569eacfc8d7452182fb57bfa2a758f580b7.zip tcl-9721f569eacfc8d7452182fb57bfa2a758f580b7.tar.gz tcl-9721f569eacfc8d7452182fb57bfa2a758f580b7.tar.bz2 |
more result generation conversion
-rw-r--r-- | generic/tclBinary.c | 24 | ||||
-rw-r--r-- | generic/tclCkalloc.c | 53 | ||||
-rw-r--r-- | generic/tclClock.c | 8 | ||||
-rw-r--r-- | generic/tclCmdAH.c | 39 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 94 | ||||
-rw-r--r-- | generic/tclEncoding.c | 6 | ||||
-rw-r--r-- | generic/tclEvent.c | 9 | ||||
-rw-r--r-- | generic/tclFCmd.c | 139 | ||||
-rw-r--r-- | generic/tclIndexObj.c | 87 | ||||
-rw-r--r-- | generic/tclParse.c | 4 | ||||
-rw-r--r-- | generic/tclPathObj.c | 16 | ||||
-rw-r--r-- | generic/tclRegexp.c | 4 | ||||
-rw-r--r-- | generic/tclResult.c | 43 | ||||
-rw-r--r-- | generic/tclTimer.c | 9 | ||||
-rw-r--r-- | generic/tclTomMathStubLib.c | 8 | ||||
-rw-r--r-- | generic/tclTrace.c | 5 | ||||
-rw-r--r-- | tests/fileSystem.test | 2 | ||||
-rw-r--r-- | tests/string.test | 4 |
18 files changed, 294 insertions, 260 deletions
diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 444e7fa..a1e836e 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -873,9 +873,9 @@ BinaryFormatCmd( if (count == BINARY_ALL) { count = listc; } else if (count > listc) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "number of elements in list does not match count", - NULL); + -1)); return TCL_ERROR; } } @@ -884,9 +884,8 @@ BinaryFormatCmd( case 'x': if (count == BINARY_ALL) { - Tcl_AppendResult(interp, - "cannot use \"*\" in format string with \"x\"", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot use \"*\" in format string with \"x\"", -1)); return TCL_ERROR; } else if (count == BINARY_NOCOUNT) { count = 1; @@ -1198,8 +1197,9 @@ BinaryFormatCmd( badValue: Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "expected ", errorString, - " string but got \"", errorValue, "\" instead", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected %s string but got \"%s\" instead", + errorString, errorValue)); return TCL_ERROR; badCount: @@ -1217,12 +1217,13 @@ BinaryFormatCmd( Tcl_UtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; - Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad field specifier \"%s\"", buf)); return TCL_ERROR; } error: - Tcl_AppendResult(interp, errorString, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1)); return TCL_ERROR; } @@ -1586,12 +1587,13 @@ BinaryScanCmd( Tcl_UtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; - Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad field specifier \"%s\"", buf)); return TCL_ERROR; } error: - Tcl_AppendResult(interp, errorString, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1)); return TCL_ERROR; } diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 5b5a0d6..6443975 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -815,15 +815,16 @@ MemoryCmd( size_t len; if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option [args..]\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s option [args..]\"", argv[0])); return TCL_ERROR; } - if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) { + if (strcmp(argv[1], "active") == 0 || strcmp(argv[1], "display") == 0) { if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " file\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s file\"", + argv[0], argv[1])); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); @@ -833,7 +834,8 @@ MemoryCmd( result = Tcl_DumpActiveMemory(fileName); Tcl_DStringFree(&buffer); if (result != TCL_OK) { - Tcl_AppendResult(interp, "error accessing ", argv[2], NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s", + argv[2], Tcl_PosixError(interp))); return TCL_ERROR; } return TCL_OK; @@ -857,17 +859,17 @@ MemoryCmd( "maximum bytes allocated", (unsigned long)maximum_bytes_malloced)); return TCL_OK; } - if (strcmp(argv[1],"init") == 0) { + if (strcmp(argv[1], "init") == 0) { if (argc != 3) { goto bad_suboption; } init_malloced_bodies = (strcmp(argv[2],"on") == 0); return TCL_OK; } - if (strcmp(argv[1],"objs") == 0) { + if (strcmp(argv[1], "objs") == 0) { if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " objs file\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s objs file\"", argv[0])); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); @@ -876,7 +878,9 @@ MemoryCmd( } fileP = fopen(fileName, "w"); if (fileP == NULL) { - Tcl_AppendResult(interp, "cannot open output file", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cannot open output file: %s", + Tcl_PosixError(interp))); return TCL_ERROR; } TclDbDumpActiveObjects(fileP); @@ -886,8 +890,8 @@ MemoryCmd( } if (strcmp(argv[1],"onexit") == 0) { if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " onexit file\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s onexit file\"", argv[0])); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); @@ -901,8 +905,8 @@ MemoryCmd( } if (strcmp(argv[1],"tag") == 0) { if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " tag string\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s tag string\"", argv[0])); return TCL_ERROR; } if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) { @@ -939,19 +943,20 @@ MemoryCmd( return TCL_OK; } - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": should be active, break_on_malloc, info, init, objs, onexit, " - "tag, trace, trace_on_at_malloc, or validate", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": should be active, break_on_malloc, info, " + "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", + argv[1])); return TCL_ERROR; argError: - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " count\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s count\"", argv[0], argv[1])); return TCL_ERROR; bad_suboption: - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " on|off\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1])); return TCL_ERROR; } @@ -981,8 +986,8 @@ CheckmemCmd( const char *argv[]) /* String values of arguments. */ { if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " fileName\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s fileName\"", argv[0])); return TCL_ERROR; } tclMemDumpFileName = dumpFile; diff --git a/generic/tclClock.c b/generic/tclClock.c index e46ac69..6d2976d 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1018,17 +1018,17 @@ ConvertUTCToLocalUsingC( tock = (time_t) fields->seconds; if ((Tcl_WideInt) tock != fields->seconds) { - Tcl_AppendResult(interp, - "number too large to represent as a Posix time", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "number too large to represent as a Posix time", -1)); Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL); return TCL_ERROR; } TzsetIfNecessary(); timeVal = ThreadSafeLocalTime(&tock); if (timeVal == NULL) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "localtime failed (clock value may be too " - "large/small to represent)", NULL); + "large/small to represent)", -1)); Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL); return TCL_ERROR; } diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 4bb993e..5ca5cf8 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -194,7 +194,8 @@ Tcl_CaseObjCmd( if (i == caseObjc-1) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "extra case pattern with no body", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra case pattern with no body", -1)); return TCL_ERROR; } @@ -409,8 +410,9 @@ Tcl_CdObjCmd( } else { result = Tcl_FSChdir(dir); if (result != TCL_OK) { - Tcl_AppendResult(interp, "couldn't change working directory to \"", - TclGetString(dir), "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't change working directory to \"%s\": %s", + TclGetString(dir), Tcl_PosixError(interp))); result = TCL_ERROR; } } @@ -642,8 +644,9 @@ EncodingDirsObjCmd( dirListObj = objv[2]; if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) { - Tcl_AppendResult(interp, "expected directory list but got \"", - TclGetString(dirListObj), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected directory list but got \"%s\"", + TclGetString(dirListObj))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH", NULL); return TCL_ERROR; @@ -1165,9 +1168,9 @@ FileAttrAccessTimeCmd( tval.modtime = buf.st_mtime; if (Tcl_FSUtime(objv[1], &tval) != 0) { - Tcl_AppendResult(interp, "could not set access time for file \"", - TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not set access time for file \"%s\": %s", + TclGetString(objv[1]), Tcl_PosixError(interp))); return TCL_ERROR; } @@ -1237,9 +1240,9 @@ FileAttrModifyTimeCmd( tval.modtime = newTime; if (Tcl_FSUtime(objv[1], &tval) != 0) { - Tcl_AppendResult(interp, "could not set modification time for " - "file \"", TclGetString(objv[1]), "\": ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not set modification time for file \"%s\": %s", + TclGetString(objv[1]), Tcl_PosixError(interp))); return TCL_ERROR; } @@ -1990,8 +1993,9 @@ PathSplitCmd( } res = Tcl_FSSplitPath(objv[1], NULL); if (res == NULL) { - Tcl_AppendResult(interp, "could not read \"", TclGetString(objv[1]), - "\": no such file or directory", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": no such file or directory", + TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH", NULL); return TCL_ERROR; @@ -2212,9 +2216,9 @@ GetStatBuf( if (status < 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - TclGetString(pathPtr), "\": ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": %s", + TclGetString(pathPtr), Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2649,7 +2653,8 @@ TclNRForeachCmd( TclListObjGetElements(NULL, statePtr->vCopyList[i], &statePtr->varcList[i], &statePtr->varvList[i]); if (statePtr->varcList[i] < 1) { - Tcl_AppendResult(interp, "foreach varlist is empty", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "foreach varlist is empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FOREACH", "NEEDVARS", NULL); result = TCL_ERROR; diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 7e94d9f..9e720ea 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -204,8 +204,8 @@ Tcl_RegexpObjCmd( */ if (doinline && ((objc - 2) != 0)) { - Tcl_AppendResult(interp, "regexp match variables not allowed" - " when using -inline", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "regexp match variables not allowed when using -inline", -1)); goto optionError; } @@ -1839,8 +1839,8 @@ StringMapCmd( strncmp(string, "-nocase", (size_t) length2) == 0) { nocase = 1; } else { - Tcl_AppendResult(interp, "bad option \"", string, - "\": must be -nocase", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be -nocase", string)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string, NULL); return TCL_ERROR; @@ -2106,8 +2106,8 @@ StringMatchCmd( strncmp(string, "-nocase", (size_t) length) == 0) { nocase = TCL_MATCH_NOCASE; } else { - Tcl_AppendResult(interp, "bad option \"", string, - "\": must be -nocase", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be -nocase", string)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string, NULL); return TCL_ERROR; @@ -2567,8 +2567,9 @@ StringEqualCmd( return TCL_ERROR; } } else { - Tcl_AppendResult(interp, "bad option \"", string2, - "\": must be -nocase or -length", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be -nocase or -length", + string2)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string2, NULL); return TCL_ERROR; @@ -2716,8 +2717,9 @@ StringCmpCmd( return TCL_ERROR; } } else { - Tcl_AppendResult(interp, "bad option \"", string2, - "\": must be -nocase or -length", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be -nocase or -length", + string2)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string2, NULL); return TCL_ERROR; @@ -3515,9 +3517,9 @@ TclNRSwitchObjCmd( * Mode already set via -exact, -glob, or -regexp. */ - Tcl_AppendResult(interp, "bad option \"", - TclGetString(objv[i]), "\": ", options[mode], - " option already found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": %s option already found", + TclGetString(objv[i]), options[mode])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "DOUBLEOPT", NULL); return TCL_ERROR; @@ -3534,8 +3536,9 @@ TclNRSwitchObjCmd( case OPT_INDEXV: i++; if (i >= objc-2) { - Tcl_AppendResult(interp, "missing variable name argument to ", - "-indexvar", " option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing variable name argument to %s option", + "-indexvar")); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "NOVAR", NULL); return TCL_ERROR; @@ -3546,8 +3549,9 @@ TclNRSwitchObjCmd( case OPT_MATCHV: i++; if (i >= objc-2) { - Tcl_AppendResult(interp, "missing variable name argument to ", - "-matchvar", " option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing variable name argument to %s option", + "-matchvar")); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "NOVAR", NULL); return TCL_ERROR; @@ -3565,15 +3569,15 @@ TclNRSwitchObjCmd( return TCL_ERROR; } if (indexVarObj != NULL && mode != OPT_REGEXP) { - Tcl_AppendResult(interp, - "-indexvar option requires -regexp option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s option requires -regexp option", "-indexvar")); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "MODERESTRICTION", NULL); return TCL_ERROR; } if (matchVarObj != NULL && mode != OPT_REGEXP) { - Tcl_AppendResult(interp, - "-matchvar option requires -regexp option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s option requires -regexp option", "-matchvar")); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "MODERESTRICTION", NULL); return TCL_ERROR; @@ -3622,7 +3626,8 @@ TclNRSwitchObjCmd( if (objc % 2) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "extra switch pattern with no body", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra switch pattern with no body", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", NULL); @@ -3637,10 +3642,10 @@ TclNRSwitchObjCmd( if (splitObjs) { for (i=0 ; i<objc ; i+=2) { if (TclGetString(objv[i])[0] == '#') { - Tcl_AppendResult(interp, ", this may be due to a " - "comment incorrectly placed outside of a " - "switch body - see the \"switch\" " - "documentation", NULL); + Tcl_AppendToObj(Tcl_GetObjResult(interp), + ", this may be due to a comment incorrectly" + " placed outside of a switch body - see the" + " \"switch\" documentation", -1); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", "COMMENT?", NULL); break; @@ -3657,9 +3662,9 @@ TclNRSwitchObjCmd( */ if (strcmp(TclGetString(objv[objc-1]), "-") == 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "no body specified for pattern \"", - TclGetString(objv[objc-2]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no body specified for pattern \"%s\"", + TclGetString(objv[objc-2]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", "FALLTHROUGH", NULL); return TCL_ERROR; @@ -3985,7 +3990,8 @@ Tcl_ThrowObjCmd( if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) { return TCL_ERROR; } else if (len < 1) { - Tcl_AppendResult(interp, "type must be non-empty list", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "type must be non-empty list", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION", NULL); return TCL_ERROR; @@ -4169,15 +4175,16 @@ TclNRTryObjCmd( switch ((enum Handlers) type) { case TryFinally: /* finally script */ if (i < objc-2) { - Tcl_AppendResult(interp, "finally clause must be last", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "finally clause must be last", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY", "NONTERMINAL", NULL); return TCL_ERROR; } else if (i == objc-1) { - Tcl_AppendResult(interp, "wrong # args to finally clause: ", - "must be \"", TclGetString(objv[0]), - " ... finally script\"", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong # args to finally clause: must be" + " \"... finally script\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY", "ARGUMENT", NULL); @@ -4188,15 +4195,16 @@ TclNRTryObjCmd( case TryOn: /* on code variableList script */ if (i > objc-4) { - Tcl_AppendResult(interp, "wrong # args to on clause: ", - "must be \"", TclGetString(objv[0]), - " ... on code variableList script\"", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong # args to on clause: must be \"... on code" + " variableList script\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON", "ARGUMENT", NULL); return TCL_ERROR; } - if (TCL_ERROR == TclGetCompletionCodeFromObj(interp, objv[i+1], &code)) { + if (TclGetCompletionCodeFromObj(interp, objv[i+1], + &code) != TCL_OK) { Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } @@ -4205,9 +4213,10 @@ TclNRTryObjCmd( case TryTrap: /* trap pattern variableList script */ if (i > objc-4) { - Tcl_AppendResult(interp, "wrong # args to trap clause: ", + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong # args to trap clause: " "must be \"... trap pattern variableList script\"", - NULL); + -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP", "ARGUMENT", NULL); @@ -4248,9 +4257,8 @@ TclNRTryObjCmd( } } if (bodyShared) { - Tcl_AppendResult(interp, - "last non-finally clause must not have a body of \"-\"", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "last non-finally clause must not have a body of \"-\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH", NULL); diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 0fa6661..7a55724 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1542,7 +1542,8 @@ OpenEncodingFileChannel( } if ((NULL == chan) && (interp != NULL)) { - Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown encoding \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL); } Tcl_DecrRefCount(fileNameObj); @@ -1616,7 +1617,8 @@ LoadEncodingFile( break; } if ((encoding == NULL) && (interp != NULL)) { - Tcl_AppendResult(interp, "invalid encoding file \"", name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid encoding file \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL); } Tcl_Close(NULL, chan); diff --git a/generic/tclEvent.c b/generic/tclEvent.c index e65862c..0b585b6 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1416,7 +1416,7 @@ Tcl_VwaitObjCmd( } if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "limit exceeded", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); break; } } @@ -1426,8 +1426,9 @@ Tcl_VwaitObjCmd( if (!foundEvent) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't wait for variable \"", nameString, - "\": would wait forever", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't wait for variable \"%s\": would wait forever", + nameString)); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL); return TCL_ERROR; } @@ -1519,7 +1520,7 @@ Tcl_UpdateObjCmd( } if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "limit exceeded", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); return TCL_ERROR; } } diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index a868fe3..032dda7 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -152,9 +152,9 @@ FileCopyRename( if ((objc - i) > 2) { errno = ENOTDIR; Tcl_PosixError(interp); - Tcl_AppendResult(interp, "error ", - (copyFlag ? "copying" : "renaming"), ": target \"", - TclGetString(target), "\" is not a directory", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error %s: target \"%s\" is not a directory", + (copyFlag?"copying":"renaming"), TclGetString(target))); result = TCL_ERROR; } else { /* @@ -304,8 +304,9 @@ TclFileMakeDirsCmd( done: if (errfile != NULL) { - Tcl_AppendResult(interp, "can't create directory \"", - TclGetString(errfile), "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't create directory \"%s\": %s", + TclGetString(errfile), Tcl_PosixError(interp))); result = TCL_ERROR; } if (split != NULL) { @@ -384,9 +385,9 @@ TclFileDeleteCmd( result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer); if (result != TCL_OK) { if ((force == 0) && (errno == EEXIST)) { - Tcl_AppendResult(interp, "error deleting \"", - TclGetString(objv[i]), "\": directory not empty", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error deleting \"%s\": directory not empty", + TclGetString(objv[i]))); Tcl_PosixError(interp); goto done; } @@ -426,12 +427,13 @@ TclFileDeleteCmd( * We try to accomodate poor error results from our Tcl_FS calls. */ - Tcl_AppendResult(interp, "error deleting unknown file: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error deleting unknown file: %s", + Tcl_PosixError(interp))); } else { - Tcl_AppendResult(interp, "error deleting \"", - TclGetString(errfile), "\": ", Tcl_PosixError(interp), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error deleting \"%s\": %s", + TclGetString(errfile), Tcl_PosixError(interp))); } } @@ -540,17 +542,17 @@ CopyRenameOneFile( if (S_ISDIR(sourceStatBuf.st_mode) && !S_ISDIR(targetStatBuf.st_mode)) { errno = EISDIR; - Tcl_AppendResult(interp, "can't overwrite file \"", - TclGetString(target), "\" with directory \"", - TclGetString(source), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't overwrite file \"%s\" with directory \"%s\"", + TclGetString(target), TclGetString(source))); goto done; } if (!S_ISDIR(sourceStatBuf.st_mode) && S_ISDIR(targetStatBuf.st_mode)) { errno = EISDIR; - Tcl_AppendResult(interp, "can't overwrite directory \"", - TclGetString(target), "\" with file \"", - TclGetString(source), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't overwrite directory \"%s\" with file \"%s\"", + TclGetString(target), TclGetString(source))); goto done; } @@ -581,10 +583,10 @@ CopyRenameOneFile( } if (errno == EINVAL) { - Tcl_AppendResult(interp, "error renaming \"", - TclGetString(source), "\" to \"", TclGetString(target), - "\": trying to rename a volume or " - "move a directory into itself", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error renaming \"%s\" to \"%s\": trying to rename a" + " volume or move a directory into itself", + TclGetString(source), TclGetString(target))); goto done; } else if (errno != EXDEV) { errfile = target; @@ -628,8 +630,9 @@ CopyRenameOneFile( * Actual file doesn't exist. */ - Tcl_AppendResult(interp, "error copying \"", TclGetString(source), - "\": the target of this link doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error copying \"%s\": the target of this link doesn't" + " exist", TclGetString(source))); goto done; } else { int counter = 0; @@ -764,23 +767,27 @@ CopyRenameOneFile( } } if (result != TCL_OK) { - Tcl_AppendResult(interp, "can't unlink \"", TclGetString(errfile), - "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't unlink \"%s\": %s", + TclGetString(errfile), Tcl_PosixError(interp))); errfile = NULL; } } done: if (errfile != NULL) { - Tcl_AppendResult(interp, "error ", (copyFlag ? "copying" : "renaming"), - " \"", TclGetString(source), NULL); + Tcl_Obj *errorMsg = Tcl_ObjPrintf("error %s \"%s\"", + (copyFlag ? "copying" : "renaming"), TclGetString(source)); + if (errfile != source) { - Tcl_AppendResult(interp, "\" to \"", TclGetString(target), NULL); + Tcl_AppendPrintfToObj(errorMsg, " to \"%s\"", + TclGetString(target)); if (errfile != target) { - Tcl_AppendResult(interp, "\": \"", TclGetString(errfile),NULL); + Tcl_AppendPrintfToObj(errorMsg, ": \"%s\"", + TclGetString(errfile)); } } - Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp), NULL); + Tcl_AppendPrintfToObj(errorMsg, ": %s", Tcl_PosixError(interp)); + Tcl_SetObjResult(interp, errorMsg); } if (errorBuffer != NULL) { Tcl_DecrRefCount(errorBuffer); @@ -983,9 +990,10 @@ TclFileAttrsCmd( * There was an error, probably that the filePtr is not * accepted by any filesystem */ - Tcl_AppendResult(interp, "could not read \"", - TclGetString(filePtr), "\": ", Tcl_PosixError(interp), - NULL); + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": %s", + TclGetString(filePtr), Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -1071,9 +1079,9 @@ TclFileAttrsCmd( Tcl_Obj *objPtr = NULL; if (numObjStrings == 0) { - Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]), - "\", there are no file attributes in this filesystem.", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\", there are no file attributes in this" + " filesystem", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL); goto end; } @@ -1098,9 +1106,9 @@ TclFileAttrsCmd( int i, index; if (numObjStrings == 0) { - Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]), - "\", there are no file attributes in this filesystem.", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\", there are no file attributes in this" + " filesystem", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL); goto end; } @@ -1114,8 +1122,8 @@ TclFileAttrsCmd( TclFreeIntRep(objv[i]); } if (i + 1 == objc) { - Tcl_AppendResult(interp, "value for \"", - TclGetString(objv[i]), "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR", "NOVALUE", NULL); goto end; @@ -1224,9 +1232,9 @@ TclFileLinkCmd( */ if (errno == EEXIST) { - Tcl_AppendResult(interp, "could not create new link \"", - TclGetString(objv[index]), - "\": that path already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not create new link \"%s\": that path already" + " exists", TclGetString(objv[index]))); Tcl_PosixError(interp); } else if (errno == ENOENT) { /* @@ -1244,23 +1252,23 @@ TclFileLinkCmd( access = Tcl_FSAccess(dirPtr, F_OK); Tcl_DecrRefCount(dirPtr); if (access != 0) { - Tcl_AppendResult(interp, "could not create new link \"", - TclGetString(objv[index]), - "\": no such file or directory", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not create new link \"%s\": no such file" + " or directory", TclGetString(objv[index]))); Tcl_PosixError(interp); } else { - Tcl_AppendResult(interp, "could not create new link \"", - TclGetString(objv[index]), "\": target \"", - TclGetString(objv[index+1]), "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not create new link \"%s\": target \"%s\" " + "doesn't exist", TclGetString(objv[index]), + TclGetString(objv[index+1]))); errno = ENOENT; Tcl_PosixError(interp); } } else { - Tcl_AppendResult(interp, "could not create new link \"", - TclGetString(objv[index]), "\" pointing to \"", - TclGetString(objv[index+1]), "\": ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not create new link \"%s\" pointing to \"%s\": %s", + TclGetString(objv[index]), + TclGetString(objv[index+1]), Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -1275,9 +1283,9 @@ TclFileLinkCmd( contents = Tcl_FSLink(objv[index], NULL, 0); if (contents == NULL) { - Tcl_AppendResult(interp, "could not read link \"", - TclGetString(objv[index]), "\": ", Tcl_PosixError(interp), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read link \"%s\": %s", + TclGetString(objv[index]), Tcl_PosixError(interp))); return TCL_ERROR; } } @@ -1332,8 +1340,9 @@ TclFileReadLinkCmd( contents = Tcl_FSLink(objv[1], NULL, 0); if (contents == NULL) { - Tcl_AppendResult(interp, "could not readlink \"", - TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read link \"%s\": %s", + TclGetString(objv[1]), Tcl_PosixError(interp))); return TCL_ERROR; } Tcl_SetObjResult(interp, contents); @@ -1487,8 +1496,8 @@ TclFileTemporaryCmd( if (nameVarObj) { TclDecrRefCount(nameObj); } - Tcl_AppendResult(interp, "can't create temporary file: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't create temporary file: %s", Tcl_PosixError(interp))); return TCL_ERROR; } Tcl_RegisterChannel(interp, chan); @@ -1499,7 +1508,7 @@ TclFileTemporaryCmd( return TCL_ERROR; } } - Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); return TCL_OK; } diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 85e0730..731d759 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -600,8 +600,9 @@ PrefixMatchObjCmd( flags |= TCL_EXACT; break; case PRFMATCH_MESSAGE: - if (i > (objc - 4)) { - Tcl_AppendResult(interp, "missing message", NULL); + if (i > objc-4) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing value for -message", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } @@ -610,7 +611,8 @@ PrefixMatchObjCmd( break; case PRFMATCH_ERROR: if (i > objc-4) { - Tcl_AppendResult(interp, "missing error options", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing value for -error", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } @@ -620,8 +622,9 @@ PrefixMatchObjCmd( return TCL_ERROR; } if ((errorLength % 2) != 0) { - Tcl_AppendResult(interp, "error options must have an even" - " number of elements", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error options must have an even number of elements", + -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); return TCL_ERROR; } @@ -1174,8 +1177,8 @@ Tcl_ParseArgsObjv( goto gotMatch; } if (matchPtr != NULL) { - Tcl_AppendResult(interp, "ambiguous option \"", str, "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous option \"%s\"", str)); goto error; } matchPtr = infoPtr; @@ -1187,8 +1190,8 @@ Tcl_ParseArgsObjv( */ if (remObjv == NULL) { - Tcl_AppendResult(interp, "unrecognized argument \"", str, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unrecognized argument \"%s\"", str)); goto error; } @@ -1213,9 +1216,9 @@ Tcl_ParseArgsObjv( } if (Tcl_GetIntFromObj(interp, objv[srcIndex], (int *) infoPtr->dstPtr) == TCL_ERROR) { - Tcl_AppendResult(interp, "expected integer argument for \"", - infoPtr->keyStr, "\" but got \"", - Tcl_GetString(objv[srcIndex]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer argument for \"%s\" but got \"%s\"", + infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); goto error; } srcIndex++; @@ -1246,9 +1249,9 @@ Tcl_ParseArgsObjv( } if (Tcl_GetDoubleFromObj(interp, objv[srcIndex], (double *) infoPtr->dstPtr) == TCL_ERROR) { - Tcl_AppendResult(interp, "expected floating-point argument ", - "for \"", infoPtr->keyStr, "\" but got \"", - Tcl_GetString(objv[srcIndex]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected floating-point argument for \"%s\" but got \"%s\"", + infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); goto error; } srcIndex++; @@ -1322,8 +1325,8 @@ Tcl_ParseArgsObjv( */ missingArg: - Tcl_AppendResult(interp, "\"", str, - "\" option requires an additional argument", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" option requires an additional argument", str)); error: if (leftovers != NULL) { ckfree(leftovers); @@ -1361,6 +1364,7 @@ PrintUsage( #define NUM_SPACES 20 static const char spaces[] = " "; char tmp[TCL_DOUBLE_SPACE]; + Tcl_Obj *msg; /* * First, compute the width of the widest option key, so that we can make @@ -1384,39 +1388,39 @@ PrintUsage( * Now add the option information, with pretty-printing. */ - Tcl_AppendResult(interp, "Command-specific options:", NULL); + msg = Tcl_NewStringObj("Command-specific options:", -1); for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) { if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) { - Tcl_AppendResult(interp, "\n", infoPtr->helpStr, NULL); + Tcl_AppendPrintfToObj(msg, "\n%s", infoPtr->helpStr); continue; } - Tcl_AppendResult(interp, "\n ", infoPtr->keyStr, ":", NULL); + Tcl_AppendPrintfToObj(msg, "\n %s:", infoPtr->keyStr); numSpaces = width + 1 - strlen(infoPtr->keyStr); while (numSpaces > 0) { if (numSpaces >= NUM_SPACES) { - Tcl_AppendResult(interp, spaces, NULL); + Tcl_AppendToObj(msg, spaces, NUM_SPACES); } else { - Tcl_AppendResult(interp, spaces+NUM_SPACES-numSpaces, NULL); + Tcl_AppendToObj(msg, spaces, numSpaces); } numSpaces -= NUM_SPACES; } - Tcl_AppendResult(interp, infoPtr->helpStr, NULL); + Tcl_AppendToObj(msg, infoPtr->helpStr, -1); switch (infoPtr->type) { case TCL_ARGV_INT: - sprintf(tmp, "%d", *((int *) infoPtr->dstPtr)); - Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL); + Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d", + *((int *) infoPtr->dstPtr)); break; case TCL_ARGV_FLOAT: + Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g", + *((double *) infoPtr->dstPtr)); sprintf(tmp, "%g", *((double *) infoPtr->dstPtr)); - Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL); break; case TCL_ARGV_STRING: { - char *string; + char *string = *((char **) infoPtr->dstPtr); - string = *((char **) infoPtr->dstPtr); if (string != NULL) { - Tcl_AppendResult(interp, "\n\t\tDefault value: \"", string, - "\"", NULL); + Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: \"%s\"", + string); } break; } @@ -1424,6 +1428,7 @@ PrintUsage( break; } } + Tcl_SetObjResult(interp, msg); } /* @@ -1435,8 +1440,8 @@ PrintUsage( * * Results: * Returns TCL_ERROR if the value is an invalid completion code. - * Otherwise, returns TCL_OK, and writes the completion code to - * the pointer provided. + * Otherwise, returns TCL_OK, and writes the completion code to the + * pointer provided. * * Side effects: * None. @@ -1448,30 +1453,30 @@ int TclGetCompletionCodeFromObj( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *value, - int *code) /* Argument objects. */ + int *codePtr) /* Argument objects. */ { static const char *const returnCodes[] = { "ok", "error", "return", "break", "continue", NULL }; if ((value->typePtr != &indexType) - && (TCL_OK == TclGetIntFromObj(NULL, value, code))) { + && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) { return TCL_OK; } - if (TCL_OK == Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, - TCL_EXACT, code)) { + if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT, + codePtr) == TCL_OK) { return TCL_OK; } + /* * Value is not a legal completion code. */ if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad completion code \"", - TclGetString(value), - "\": must be ok, error, return, break, " - "continue, or an integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad completion code \"%s\": must be" + " ok, error, return, break, continue, or an integer", + TclGetString(value))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL); } return TCL_ERROR; diff --git a/generic/tclParse.c b/generic/tclParse.c index aab2fac..309e232 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -1779,8 +1779,8 @@ Tcl_ParseBraces( break; case '#' : if (openBrace && TclIsSpaceProc(src[-1])) { - Tcl_AppendResult(parsePtr->interp, - ": possible unbalanced brace in comment", NULL); + Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp), + ": possible unbalanced brace in comment", -1); goto error; } break; diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 8bae4fb..db07c0e 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -1492,9 +1492,8 @@ MakePathFromNormalized( if (pathPtr->bytes == NULL) { if (pathPtr->typePtr->updateStringProc == NULL) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't find object" - "string representation", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't find object string representation", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF", NULL); } @@ -2368,9 +2367,9 @@ SetFsPathFromAny( dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't find HOME environment " - "variable to expand path", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find HOME environment variable to" + " expand path", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "HOMELESS", NULL); } @@ -2387,9 +2386,8 @@ SetFsPathFromAny( Tcl_DStringInit(&temp); if (TclpGetUserHome(name+1, &temp) == NULL) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "user \"", name+1, - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "user \"%s\" doesn't exist", name+1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", NULL); } diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 53d7153..6c1dc08 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -714,14 +714,14 @@ TclRegError( int status) /* Status code to report. */ { char buf[100]; /* ample in practice */ - char cbuf[100]; /* lots in practice */ + char cbuf[TCL_INTEGER_SPACE]; size_t n; const char *p; Tcl_ResetResult(interp); n = TclReError(status, NULL, buf, sizeof(buf)); p = (n > sizeof(buf)) ? "..." : ""; - Tcl_AppendResult(interp, msg, buf, p, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p)); sprintf(cbuf, "%d", status); (void) TclReError(REG_ITOA, NULL, cbuf, sizeof(cbuf)); diff --git a/generic/tclResult.c b/generic/tclResult.c index 4443cc1..17aac74 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -1390,10 +1390,9 @@ TclMergeReturnOptions( * Value is not a legal dictionary. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad ", compare, - " value: expected dictionary but got \"", - TclGetString(objv[1]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad %s value: expected dictionary but got \"%s\"", + compare, TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", NULL); goto error; @@ -1440,10 +1439,9 @@ TclMergeReturnOptions( * Value is not a legal level. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad -level value: " - "expected non-negative integer but got \"", - TclGetString(valuePtr), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad -level value: expected non-negative integer but got" + " \"%s\"", TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", NULL); goto error; } @@ -1462,10 +1460,10 @@ TclMergeReturnOptions( /* * Value is not a list, which is illegal for -errorcode. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad -errorcode value: " - "expected a list but got \"", - TclGetString(valuePtr), "\"", NULL); + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad -errorcode value: expected a list but got \"%s\"", + TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE", NULL); goto error; @@ -1484,10 +1482,10 @@ TclMergeReturnOptions( /* * Value is not a list, which is illegal for -errorstack. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad -errorstack value: " - "expected a list but got \"", TclGetString(valuePtr), - "\"", NULL); + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad -errorstack value: expected a list but got \"%s\"", + TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK", NULL); goto error; @@ -1496,10 +1494,10 @@ TclMergeReturnOptions( /* * Errorstack must always be an even-sized list */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "forbidden odd-sized list for -errorstack: \"", - TclGetString(valuePtr), "\"", NULL); + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "forbidden odd-sized list for -errorstack: \"%s\"", + TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ODDSIZEDLIST_ERRORSTACK", NULL); goto error; @@ -1650,9 +1648,8 @@ Tcl_SetReturnOptions( Tcl_IncrRefCount(options); if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv) || (objc % 2)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "expected dict but got \"", - TclGetString(options), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected dict but got \"%s\"", TclGetString(options))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", NULL); code = TCL_ERROR; } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv, diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 36adaad..6b17825 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -829,8 +829,9 @@ Tcl_AfterObjCmd( if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { const char *arg = Tcl_GetString(objv[1]); - Tcl_AppendResult(interp, "bad argument \"", arg, - "\": must be cancel, idle, info, or an integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be" + " cancel, idle, info, or an integer", arg)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", arg, NULL); return TCL_ERROR; @@ -968,8 +969,8 @@ Tcl_AfterObjCmd( if (afterPtr == NULL) { const char *eventStr = TclGetString(objv[2]); - Tcl_AppendResult(interp, "event \"", eventStr, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "event \"%s\" doesn't exist", eventStr)); Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL); return TCL_ERROR; } else { diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c index e7e4aea..a3bc4b3 100644 --- a/generic/tclTomMathStubLib.c +++ b/generic/tclTomMathStubLib.c @@ -73,10 +73,10 @@ TclTomMathInitializeStubs( tclTomMathStubsPtr = stubsPtr; return actualVersion; } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "error loading ", packageName, - " (requested version ", version, ", actual version ", - actualVersion, "): ", errMsg, NULL); + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error loading %s (requested version %s, actual version %s): %s", + packageName, version, actualVersion, errMsg)); return NULL; } diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 3888549..519f201 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -366,8 +366,9 @@ Tcl_TraceObjCmd( return TCL_OK; badVarOps: - Tcl_AppendResult(interp, "bad operations \"", flagOps, - "\": should be one or more of rwua", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad operations \"%s\": should be one or more of rwua", + flagOps)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL); return TCL_ERROR; } diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 9469af0..38ecbee 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -484,7 +484,7 @@ test filesystem-6.22 {empty file name} {file pathtype ""} relative test filesystem-6.23 {empty file name} {file readable ""} 0 test filesystem-6.24 {empty file name} -returnCodes error -body { file readlink "" -} -result {could not readlink "": no such file or directory} +} -result {could not read link "": no such file or directory} test filesystem-6.25 {empty file name} -returnCodes error -body { file rename "" "" } -result {error renaming "": no such file or directory} diff --git a/tests/string.test b/tests/string.test index 8cacd07..e86c0de 100644 --- a/tests/string.test +++ b/tests/string.test @@ -1776,10 +1776,10 @@ test string-26.3.1 {tcl::prefix, bad args} -body { } -returnCodes 1 -result {error options must have an even number of elements} test string-26.3.2 {tcl::prefix, bad args} -body { tcl::prefix match -error str1 str2 -} -returnCodes 1 -result {missing error options} +} -returnCodes 1 -result {missing value for -error} test string-26.4 {tcl::prefix, bad args} -body { tcl::prefix match -message str1 str2 -} -returnCodes 1 -result {missing message} +} -returnCodes 1 -result {missing value for -message} test string-26.5 {tcl::prefix} { tcl::prefix match {apa bepa cepa depa} cepa } cepa |