summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-04-02 12:17:32 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-04-02 12:17:32 (GMT)
commitf4b7658650c49deb8518bb22558332a16264cdf6 (patch)
tree0e5e3455e80f30f4b9cd842f575ebf50c5cd8fe6
parent4502b1fa0696dd647f8a38b72b8f689433bf98cd (diff)
downloadtcl-f4b7658650c49deb8518bb22558332a16264cdf6.zip
tcl-f4b7658650c49deb8518bb22558332a16264cdf6.tar.gz
tcl-f4b7658650c49deb8518bb22558332a16264cdf6.tar.bz2
More generation of errorCode information (default [bgerror] and [glob]).
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclEvent.c2
-rw-r--r--generic/tclFileName.c17
3 files changed, 24 insertions, 0 deletions
diff --git a/ChangeLog b/ChangeLog
index 86ef9e4..f0d5bcc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2011-04-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclEvent.c, generic/tclFileName.c: More generation of
+ errorCode information (default [bgerror] and [glob]).
+
2011-04-01 Reinhard Max <max@suse.de>
* library/init.tcl: TIP#131 implementation.
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index a8bab0b..6816487 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -333,6 +333,7 @@ TclDefaultBgErrorHandlerObjCmd(
if (valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-level\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) {
@@ -345,6 +346,7 @@ TclDefaultBgErrorHandlerObjCmd(
if (valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-code\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) {
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index d53c271..05ecb04 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -1258,11 +1258,14 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-directory\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
if (dir != PATH_NONE) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-directory\" cannot be used with \"-path\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
+ "BADOPTIONCOMBINATION", NULL);
return TCL_ERROR;
}
dir = PATH_DIR;
@@ -1280,11 +1283,14 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-path\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
if (dir != PATH_NONE) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-path\" cannot be used with \"-directory\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
+ "BADOPTIONCOMBINATION", NULL);
return TCL_ERROR;
}
dir = PATH_GENERAL;
@@ -1295,6 +1301,7 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-types\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
typePtr = objv[i+1];
@@ -1314,6 +1321,8 @@ Tcl_GlobObjCmd(
Tcl_AppendResult(interp,
"\"-tails\" must be used with either "
"\"-directory\" or \"-path\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
+ "BADOPTIONCOMBINATION", NULL);
return TCL_ERROR;
}
@@ -1523,6 +1532,7 @@ Tcl_GlobObjCmd(
Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
Tcl_AppendObjToObj(resultPtr, look);
Tcl_SetObjResult(interp, resultPtr);
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
result = TCL_ERROR;
join = 0;
goto endOfGlob;
@@ -1532,6 +1542,7 @@ Tcl_GlobObjCmd(
"only one MacOS type or creator argument"
" to \"-types\" allowed", -1));
result = TCL_ERROR;
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
join = 0;
goto endOfGlob;
}
@@ -1620,6 +1631,8 @@ Tcl_GlobObjCmd(
}
}
Tcl_AppendResult(interp, "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
+ NULL);
result = TCL_ERROR;
}
}
@@ -2250,11 +2263,15 @@ DoGlob(
}
Tcl_SetResult(interp, "unmatched open-brace in file name",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
+ NULL);
return TCL_ERROR;
} else if (*p == '}') {
Tcl_SetResult(interp, "unmatched close-brace in file name",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
+ NULL);
return TCL_ERROR;
}
}