diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCmdMZ.c | 83 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 43 |
2 files changed, 77 insertions, 49 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 724c35e..0d3a3a8 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.160 2007/11/23 15:00:23 dkf Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.161 2007/12/03 13:46:28 dkf Exp $ */ #include "tclInt.h" @@ -3469,7 +3469,7 @@ Tcl_SwitchObjCmd( matchVarObj = NULL; numMatchesSaved = 0; noCase = 0; - for (i = 1; i < objc; i++) { + for (i = 1; i < objc-2; i++) { if (TclGetString(objv[i])[0] != '-') { break; } @@ -3477,40 +3477,24 @@ Tcl_SwitchObjCmd( &index) != TCL_OK) { return TCL_ERROR; } - if (index == OPT_LAST) { - i++; - break; - } - - /* - * Check for TIP#75 options specifying the variables to write regexp - * information into. - */ + switch ((enum options) index) { + /* + * General options. + */ - if (index == OPT_INDEXV) { + case OPT_LAST: i++; - if (i == objc) { - Tcl_AppendResult(interp, - "missing variable name argument to -indexvar option", - NULL); - return TCL_ERROR; - } - indexVarObj = objv[i]; - numMatchesSaved = -1; - } else if (index == OPT_MATCHV) { - i++; - if (i == objc) { - Tcl_AppendResult(interp, - "missing variable name argument to -matchvar option", - NULL); - return TCL_ERROR; - } - matchVarObj = objv[i]; - numMatchesSaved = -1; - } else if (index == OPT_NOCASE) { + goto finishedOptions; + case OPT_NOCASE: strCmpFn = strcasecmp; noCase = 1; - } else { + break; + + /* + * Handle the different switch mode options. + */ + + default: if (foundmode) { /* * Mode already set via -exact, -glob, or -regexp. @@ -3520,12 +3504,41 @@ Tcl_SwitchObjCmd( TclGetString(objv[i]), "\": ", options[mode], " option already found", NULL); return TCL_ERROR; + } else { + foundmode = 1; + mode = index; + break; + } + + /* + * Check for TIP#75 options specifying the variables to write + * regexp information into. + */ + + case OPT_INDEXV: + i++; + if (i >= objc-2) { + Tcl_AppendResult(interp, "missing variable name argument to ", + "-indexvar", " option", NULL); + return TCL_ERROR; } - foundmode = 1; - mode = index; + indexVarObj = objv[i]; + numMatchesSaved = -1; + break; + case OPT_MATCHV: + i++; + if (i >= objc-2) { + Tcl_AppendResult(interp, "missing variable name argument to ", + "-matchvar", " option", NULL); + return TCL_ERROR; + } + matchVarObj = objv[i]; + numMatchesSaved = -1; + break; } } + finishedOptions: if (objc - i < 2) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? string pattern body ... ?default body?"); @@ -3545,7 +3558,7 @@ Tcl_SwitchObjCmd( stringObj = objv[i]; objc -= i + 1; objv += i + 1; - bidx = i+1; /* First after the match string. */ + bidx = i + 1; /* First after the match string. */ /* * If all of the pattern/command pairs are lumped into a single argument, diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 0c603c5..c47d4a1 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.132 2007/11/24 12:57:56 dkf Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.133 2007/12/03 13:46:28 dkf Exp $ */ #include "tclInt.h" @@ -3856,14 +3856,14 @@ TclCompileSwitchCmd( /* * Only handle the following versions: - * switch -- word {pattern body ...} - * switch -exact -- word {pattern body ...} - * switch -glob -- word {pattern body ...} - * switch -regexp -- word {pattern body ...} - * switch -- word simpleWordPattern simpleWordBody ... - * switch -exact -- word simpleWordPattern simpleWordBody ... - * switch -glob -- word simpleWordPattern simpleWordBody ... - * switch -regexp -- word simpleWordPattern simpleWordBody ... + * switch ?--? word {pattern body ...} + * switch -exact ?--? word {pattern body ...} + * switch -glob ?--? word {pattern body ...} + * switch -regexp ?--? word {pattern body ...} + * switch -- word simpleWordPattern simpleWordBody ... + * switch -exact -- word simpleWordPattern simpleWordBody ... + * switch -glob -- word simpleWordPattern simpleWordBody ... + * switch -regexp -- word simpleWordPattern simpleWordBody ... * When the mode is -glob, can also handle a -nocase flag. * * First off, we don't care how the command's word was generated; we're @@ -3875,15 +3875,29 @@ TclCompileSwitchCmd( numWords = parsePtr->numWords-1; /* - * Check for options. There must be at least one, --, because without that - * there is no way to statically avoid the problems you get from strings- - * -to-be-matched that start with a - (the interpreted code falls apart if - * it encounters them, so we punt if we *might* encounter them as that is - * the easiest way of emulating the behaviour). + * Check for options. */ noCase = 0; mode = Switch_Exact; + if (numWords == 2) { + /* + * There's just the switch value and the bodies list. In that case, we + * can skip all option parsing and move on to consider switch values + * and the body list. + */ + + goto finishedOptionParse; + } + + /* + * There must be at least one option, --, because without that there is no + * way to statically avoid the problems you get from strings-to-be-matched + * that start with a - (the interpreted code falls apart if it encounters + * them, so we punt if we *might* encounter them as that is the easiest + * way of emulating the behaviour). + */ + for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) { register unsigned size = tokenPtr[1].size; register const char *chrs = tokenPtr[1].start; @@ -3960,6 +3974,7 @@ TclCompileSwitchCmd( * compilable too. */ + finishedOptionParse: valueTokenPtr = tokenPtr; /* For valueIndex, see previous loop. */ tokenPtr = TokenAfter(tokenPtr); |