diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2011-04-02 12:17:32 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2011-04-02 12:17:32 (GMT) |
| commit | f4b7658650c49deb8518bb22558332a16264cdf6 (patch) | |
| tree | 0e5e3455e80f30f4b9cd842f575ebf50c5cd8fe6 | |
| parent | 4502b1fa0696dd647f8a38b72b8f689433bf98cd (diff) | |
| download | tcl-f4b7658650c49deb8518bb22558332a16264cdf6.zip tcl-f4b7658650c49deb8518bb22558332a16264cdf6.tar.gz tcl-f4b7658650c49deb8518bb22558332a16264cdf6.tar.bz2 | |
More generation of errorCode information (default [bgerror] and [glob]).
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclEvent.c | 2 | ||||
| -rw-r--r-- | generic/tclFileName.c | 17 |
3 files changed, 24 insertions, 0 deletions
@@ -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; } } |