summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclNamesp.c4
-rw-r--r--generic/tclObj.c2
-rw-r--r--generic/tclPathObj.c6
-rw-r--r--generic/tclPipe.c18
-rw-r--r--generic/tclPkg.c44
-rw-r--r--generic/tclProc.c68
-rw-r--r--generic/tclResult.c15
-rw-r--r--generic/tclScan.c11
-rw-r--r--tests/ioCmd.test6
10 files changed, 141 insertions, 41 deletions
diff --git a/ChangeLog b/ChangeLog
index 23b3f1e..b734896 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2011-04-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclNamesp.c, generic/tclObj.c, generic/tclPathObj.c:
+ * generic/tclPipe.c, generic/tclPkg.c, generic/tclProc.c:
+ * generic/tclScan.c: More generation of error codes (namespace
+ creation, path normalization, pipeline creation, package handling,
+ procedures, [scan] formats)
+
2011-04-02 Kevin B. Kenny <kennykb@acm.org>
* generic/tclStrToD.c (QuickConversion): Replaced another couple
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 3a08221..45b9f6d 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -690,6 +690,8 @@ Tcl_CreateNamespace(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "can't create namespace \"\": "
"only global namespace can have empty name", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
+ "CREATEGLOBAL", NULL);
return NULL;
} else {
/*
@@ -725,6 +727,8 @@ Tcl_CreateNamespace(
) {
Tcl_AppendResult(interp, "can't create namespace \"", name,
"\": already exists", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
+ "CREATEEXISTING", NULL);
return NULL;
}
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 321ed67..630226f 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -2265,6 +2265,8 @@ Tcl_GetDoubleFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"floating point value is Not a Number", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN",
+ NULL);
}
return TCL_ERROR;
}
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 81007a2..01a297b 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -1523,6 +1523,8 @@ TclFSMakePathFromNormalized(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "can't find object"
"string representation", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
+ NULL);
}
return TCL_ERROR;
}
@@ -2423,6 +2425,8 @@ SetFsPathFromAny(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't find HOME environment "
"variable to expand path", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
+ "HOMELESS", NULL);
}
return TCL_ERROR;
}
@@ -2440,6 +2444,8 @@ SetFsPathFromAny(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "user \"", name+1,
"\" doesn't exist", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
+ NULL);
}
Tcl_DStringFree(&temp);
if (split != len) {
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index c24d136..5f59c38 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -109,6 +109,8 @@ FileForRedirect(
Tcl_AppendResult(interp, "channel \"",
Tcl_GetChannelName(chan), "\" wasn't opened for ",
((writing) ? "writing" : "reading"), NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "BADCHAN", NULL);
}
return NULL;
}
@@ -151,6 +153,7 @@ FileForRedirect(
badLastArg:
Tcl_AppendResult(interp, "can't specify \"", arg,
"\" as last word in command", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", NULL);
return NULL;
}
@@ -342,6 +345,8 @@ TclCleanupChildren(
} else {
Tcl_AppendResult(interp,
"child wait status didn't make sense\n", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "ODDWAITRESULT", msg1, NULL);
}
}
}
@@ -539,6 +544,8 @@ TclCreatePipeline(
if ((i == (lastBar + 1)) || (i == (argc - 1))) {
Tcl_SetResult(interp, "illegal use of | or |& in command",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "PIPESYNTAX", NULL);
goto error;
}
}
@@ -565,6 +572,8 @@ TclCreatePipeline(
if (inputLiteral == NULL) {
Tcl_AppendResult(interp, "can't specify \"", argv[i],
"\" as last word in command", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "PIPESYNTAX", NULL);
goto error;
}
skip = 2;
@@ -673,6 +682,8 @@ TclCreatePipeline(
if (i != argc-1) {
Tcl_AppendResult(interp, "must specify \"", argv[i],
"\" as last word in command", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "PIPESYNTAX", NULL);
goto error;
}
errorFile = outputFile;
@@ -713,6 +724,8 @@ TclCreatePipeline(
Tcl_SetResult(interp, "illegal use of | or |& in command",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX",
+ NULL);
goto error;
}
@@ -1063,11 +1076,15 @@ Tcl_OpenCommandChannel(
if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
Tcl_AppendResult(interp, "can't read output from command:"
" standard output was redirected", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "BADREDIRECT", NULL);
goto error;
}
if ((flags & TCL_STDIN) && (inPipe == NULL)) {
Tcl_AppendResult(interp, "can't write input to command:"
" standard input was redirected", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "BADREDIRECT", NULL);
goto error;
}
}
@@ -1078,6 +1095,7 @@ Tcl_OpenCommandChannel(
if (channel == NULL) {
Tcl_AppendResult(interp, "pipe for command could not be created",
NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", NULL);
goto error;
}
return channel;
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 53be4af..67503cb 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -156,6 +156,7 @@ Tcl_PkgProvideEx(
}
Tcl_AppendResult(interp, "conflicting versions provided for package \"",
name, "\": ", pkgPtr->version, ", then ", version, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
return TCL_ERROR;
}
@@ -286,6 +287,7 @@ Tcl_PkgRequireEx(
Tcl_AppendResult(interp, "Cannot load package \"", name,
"\" in standalone executable: This package is not "
"compiled with stub support", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", NULL);
return NULL;
}
@@ -376,6 +378,7 @@ PkgRequireCore(
"attempt to provide ", name, " ",
(char *) pkgPtr->clientData, " requires ", name, NULL);
AddRequirementsToResult(interp, reqc, reqv);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
return NULL;
}
@@ -422,7 +425,9 @@ PkgRequireCore(
}
}
- /* We have found a version which is better than our max. */
+ /*
+ * We have found a version which is better than our max.
+ */
if (reqc > 0) {
/* Check satisfaction of requirements. */
@@ -493,6 +498,8 @@ PkgRequireCore(
name, " ", versionToProvide,
" failed: no version of package ", name,
" provided", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
+ NULL);
} else {
char *pvi, *vi;
@@ -515,6 +522,8 @@ PkgRequireCore(
versionToProvide, " failed: package ",
name, " ", pkgPtr->version,
" provided instead", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
+ "WRONGPROVIDE", NULL);
}
}
}
@@ -525,6 +534,7 @@ PkgRequireCore(
Tcl_AppendResult(interp, "attempt to provide package ", name,
" ", versionToProvide, " failed: bad return code: ",
TclGetString(codePtr), NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
TclDecrRefCount(codePtr);
code = TCL_ERROR;
}
@@ -582,9 +592,11 @@ PkgRequireCore(
if ((code != TCL_OK) && (code != TCL_ERROR)) {
Tcl_Obj *codePtr = Tcl_NewIntObj(code);
+
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad return code: ",
TclGetString(codePtr), NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
Tcl_DecrRefCount(codePtr);
code = TCL_ERROR;
}
@@ -599,6 +611,7 @@ PkgRequireCore(
if (pkgPtr->version == NULL) {
Tcl_AppendResult(interp, "can't find package ", name, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
AddRequirementsToResult(interp, reqc, reqv);
return NULL;
}
@@ -608,27 +621,28 @@ PkgRequireCore(
* provided version meets the current requirements.
*/
- if (reqc == 0) {
- satisfies = 1;
- } else {
+ if (reqc != 0) {
CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
ckfree(pkgVersionI);
- }
- if (satisfies) {
- if (clientDataPtr) {
- const void **ptr = (const void **) clientDataPtr;
- *ptr = pkgPtr->clientData;
+ if (!satisfies) {
+ Tcl_AppendResult(interp, "version conflict for package \"", name,
+ "\": have ", pkgPtr->version, ", need", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
+ NULL);
+ AddRequirementsToResult(interp, reqc, reqv);
+ return NULL;
}
- return pkgPtr->version;
}
- Tcl_AppendResult(interp, "version conflict for package \"", name,
- "\": have ", pkgPtr->version, ", need", NULL);
- AddRequirementsToResult(interp, reqc, reqv);
- return NULL;
+ if (clientDataPtr) {
+ const void **ptr = (const void **) clientDataPtr;
+
+ *ptr = pkgPtr->clientData;
+ }
+ return pkgPtr->version;
}
/*
@@ -1328,6 +1342,7 @@ CheckVersionAndConvert(
ckfree(ibuf);
Tcl_AppendResult(interp, "expected version number but got \"", string,
"\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
return TCL_ERROR;
}
@@ -1590,6 +1605,7 @@ CheckRequirement(
Tcl_AppendResult(interp, "expected versionMin-versionMax but got \"",
string, "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", NULL);
return TCL_ERROR;
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 6cd5bb2..9f4ba29 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -154,11 +154,13 @@ Tcl_ProcObjCmd(
if (nsPtr == NULL) {
Tcl_AppendResult(interp, "can't create procedure \"", fullName,
"\": unknown namespace", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
if (procName == NULL) {
Tcl_AppendResult(interp, "can't create procedure \"", fullName,
"\": bad procedure name", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
if ((nsPtr != iPtr->globalNsPtr)
@@ -166,6 +168,7 @@ Tcl_ProcObjCmd(
Tcl_AppendResult(interp, "can't create procedure \"", procName,
"\" in non-global namespace with name starting with \":\"",
NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
@@ -490,6 +493,8 @@ TclCreateProc(
"procedure \"%s\": arg list contains %d entries, "
"precompiled header expects %d", procName, numArgs,
procPtr->numArgs));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "BYTECODELIES", NULL);
goto procError;
}
localPtr = procPtr->firstLocalPtr;
@@ -516,11 +521,15 @@ TclCreateProc(
Tcl_AppendResult(interp,
"too many fields in argument specifier \"",
argArray[i], "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "FORMALARGUMENTFORMAT", NULL);
goto procError;
}
if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
ckfree(fieldValues);
Tcl_AppendResult(interp, "argument with no name", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "FORMALARGUMENTFORMAT", NULL);
goto procError;
}
@@ -547,12 +556,16 @@ TclCreateProc(
Tcl_AppendResult(interp, "formal parameter \"",
fieldValues[0], "\" is an array element", NULL);
ckfree(fieldValues);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "FORMALARGUMENTFORMAT", NULL);
goto procError;
}
} else if ((*p == ':') && (*(p+1) == ':')) {
Tcl_AppendResult(interp, "formal parameter \"",
fieldValues[0], "\" is not a simple name", NULL);
ckfree(fieldValues);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "FORMALARGUMENTFORMAT", NULL);
goto procError;
}
p++;
@@ -580,6 +593,8 @@ TclCreateProc(
"procedure \"%s\": formal parameter %d is "
"inconsistent with precompiled body", procName, i));
ckfree(fieldValues);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "BYTECODELIES", NULL);
goto procError;
}
@@ -599,6 +614,8 @@ TclCreateProc(
"default value inconsistent with precompiled body",
procName, fieldValues[0]));
ckfree(fieldValues);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "BYTECODELIES", NULL);
goto procError;
}
}
@@ -752,6 +769,7 @@ TclGetFrame(
levelError:
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
return -1;
}
@@ -884,7 +902,7 @@ TclObjGetFrame(
levelError:
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LEVEL", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
return -1;
}
@@ -1863,6 +1881,7 @@ InterpProcNR2(
Tcl_AppendResult(interp, "invoked \"",
((result == TCL_BREAK) ? "break" : "continue"),
"\" outside of a loop", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL);
result = TCL_ERROR;
/*
@@ -1980,6 +1999,8 @@ TclProcCompileProc(
if ((Interp *) *codePtr->interpHandle != iPtr) {
Tcl_AppendResult(interp,
"a precompiled script jumped interps", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "CROSSINTERPBYTECODE", NULL);
return TCL_ERROR;
}
codePtr->compileEpoch = iPtr->compileEpoch;
@@ -2468,6 +2489,7 @@ SetLambdaFromAny(
Tcl_AppendObjToObj(errPtr, objPtr);
Tcl_AppendToObj(errPtr, "\" as a lambda expression", -1);
Tcl_SetObjResult(interp, errPtr);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
return TCL_ERROR;
}
@@ -2893,26 +2915,28 @@ Tcl_DisassembleObjCmd(
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "procName");
return TCL_ERROR;
- } else {
- procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
- if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
- "\" isn't a procedure", NULL);
- return TCL_ERROR;
- }
+ }
- /*
- * Compile (if uncompiled) and disassemble a procedure.
- */
+ procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
+ if (procPtr == NULL) {
+ Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
+ "\" isn't a procedure", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
- result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
- if (result != TCL_OK) {
- return result;
- }
- TclPopStackFrame(interp);
- codeObjPtr = procPtr->bodyPtr;
- break;
+ /*
+ * Compile (if uncompiled) and disassemble a procedure.
+ */
+
+ result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
+ if (result != TCL_OK) {
+ return result;
}
+ TclPopStackFrame(interp);
+ codeObjPtr = procPtr->bodyPtr;
+ break;
case DISAS_SCRIPT:
/*
* Compile and disassemble a script.
@@ -2947,6 +2971,8 @@ Tcl_DisassembleObjCmd(
if (oPtr->classPtr == NULL) {
Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
"\" is not a class", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
@@ -2980,12 +3006,16 @@ Tcl_DisassembleObjCmd(
unknownMethod:
Tcl_AppendResult(interp, "unknown method \"",
TclGetString(objv[3]), "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[3]), NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
Tcl_AppendResult(interp,
"body not available for this kind of method", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "METHODTYPE", NULL);
return TCL_ERROR;
}
if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
@@ -3019,6 +3049,8 @@ Tcl_DisassembleObjCmd(
if (((ByteCode *) codeObjPtr->internalRep.otherValuePtr)->flags
& TCL_BYTECODE_PRECOMPILED) {
Tcl_AppendResult(interp,"may not disassemble prebuilt bytecode",NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "BYTECODE", NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(codeObjPtr));
diff --git a/generic/tclResult.c b/generic/tclResult.c
index fad3b82..6a71ee2 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1487,9 +1487,10 @@ TclMergeReturnOptions(
*/
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad -errorstack value: "
- "expected a list but got \"",
- TclGetString(valuePtr), "\"", NULL);
- Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK", NULL);
+ "expected a list but got \"", TclGetString(valuePtr),
+ "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
+ NULL);
goto error;
}
if (length % 2) {
@@ -1497,9 +1498,11 @@ 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_SetErrorCode(interp, "TCL", "RESULT", "ODDSIZEDLIST_ERRORSTACK", NULL);
+ Tcl_AppendResult(interp,
+ "forbidden odd-sized list for -errorstack: \"",
+ TclGetString(valuePtr), "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "RESULT",
+ "ODDSIZEDLIST_ERRORSTACK", NULL);
goto error;
}
}
diff --git a/generic/tclScan.c b/generic/tclScan.c
index c862be4..68b8d21 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -331,6 +331,7 @@ ValidateFormat(
Tcl_SetResult(interp,
"cannot mix \"%\" and \"%n$\" conversion specifiers",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL);
goto error;
}
@@ -377,6 +378,7 @@ ValidateFormat(
Tcl_SetResult(interp,
"field width may not be specified in %c conversion",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL);
goto error;
}
/*
@@ -390,6 +392,7 @@ ValidateFormat(
Tcl_AppendResult(interp,
"field size modifier may not be specified in %", buf,
" conversion", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL);
goto error;
}
/*
@@ -408,6 +411,7 @@ ValidateFormat(
if (flags & SCAN_BIG) {
Tcl_SetResult(interp,
"unsigned bignum scans are invalid", TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
goto error;
}
break;
@@ -444,11 +448,13 @@ ValidateFormat(
badSet:
Tcl_SetResult(interp, "unmatched [ in format string",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL);
goto error;
default:
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
Tcl_AppendResult(interp, "bad scan conversion character \"", buf,
"\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
goto error;
}
if (!(flags & SCAN_SUPPRESS)) {
@@ -495,6 +501,7 @@ ValidateFormat(
Tcl_SetResult(interp,
"variable is assigned by multiple \"%n$\" conversion specifiers",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL);
goto error;
} else if (!xpgSize && (nassign[i] == 0)) {
/*
@@ -505,6 +512,7 @@ ValidateFormat(
Tcl_SetResult(interp,
"variable is not assigned by any conversion specifiers",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL);
goto error;
}
}
@@ -516,10 +524,12 @@ ValidateFormat(
if (gotXpg) {
Tcl_SetResult(interp, "\"%n$\" argument index out of range",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL);
} else {
Tcl_SetResult(interp,
"different numbers of variable names and field specifiers",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL);
}
error:
@@ -991,6 +1001,7 @@ Tcl_ScanObjCmd(
continue;
}
result++;
+#warning Why make your own error message? Why?
if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) {
Tcl_AppendResult(interp, "couldn't set variable \"",
TclGetString(objv[i+3]), "\"", NULL);
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index c83d174..82f83db 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -386,13 +386,13 @@ test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
set f [open $path(test4) w]
close $f
list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
-} {1 {can't write input to command: standard input was redirected} NONE}
+} {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
-} {1 {can't read output from command: standard output was redirected} NONE}
+} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
-} {1 {can't read output from command: standard output was redirected} NONE}
+} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.4 {I/O to command pipelines} unixOrPc {
list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
} {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}
generated by cgit v0.12 at 2024-11-18 12:50:26 (GMT)