Implement TIP 730: switch -integer

Author: dkfellows

doc/switch.n

@@ -12,53 +12,63 @@
 .SH NAME
 switch \- Evaluate one of several scripts, depending on a given value
 .SH SYNOPSIS
-\fBswitch \fR?\fIoptions\fR?\fI string pattern body \fR?\fIpattern body \fR...?
+\fBswitch \fR?\fIoptions\fR?\fI value pattern body \fR?\fIpattern body \fR...?
 .sp
-\fBswitch \fR?\fIoptions\fR?\fI string \fR{\fIpattern body \fR?\fIpattern body \fR...?}
+\fBswitch \fR?\fIoptions\fR?\fI value \fR{\fIpattern body \fR?\fIpattern body \fR...?}
 .BE
 .SH DESCRIPTION
 .PP
-The \fBswitch\fR command matches its \fIstring\fR argument against each of
+The \fBswitch\fR command matches its \fIvalue\fR argument against each of
 the \fIpattern\fR arguments in order.
-As soon as it finds a \fIpattern\fR that matches \fIstring\fR it
+As soon as it finds a \fIpattern\fR that matches \fIvalue\fR it
 evaluates the following \fIbody\fR argument by passing it recursively
 to the Tcl interpreter and returns the result of that evaluation.
 If the last \fIpattern\fR argument is \fBdefault\fR then it matches
 anything.
 If no \fIpattern\fR argument
-matches \fIstring\fR and no default is given, then the \fBswitch\fR
+matches \fIvalue\fR and no default is given, then the \fBswitch\fR
 command returns an empty string.
 .PP
 If the initial arguments to \fBswitch\fR start with \fB\-\fR then
 they are treated as options
 unless there are exactly two arguments to \fBswitch\fR (in which case the
-first must the \fIstring\fR and the second must be the
+first must the \fIvalue\fR and the second must be the
 \fIpattern\fR/\fIbody\fR list).
 The following options are currently supported:
 .\" OPTION: -exact
 .TP 10
 \fB\-exact\fR
 .
-Use exact matching when comparing \fIstring\fR to a pattern.  This
+Use exact matching when comparing \fIvalue\fR to a pattern.  This
 is the default.
 .\" OPTION: -glob
 .TP 10
 \fB\-glob\fR
 .
-When matching \fIstring\fR to the patterns, use glob-style matching
+When matching \fIvalue\fR to the patterns, use glob-style matching
 (i.e. the same as implemented by the \fBstring match\fR command).
+.\" OPTION: -integer
+.TP 10
+\fB\-integer\fR
+.VS 9.1
+.\" TIP #730
+When matching \fIvalue\fR to the patterns, use integer comparisons. Note
+that this makes using a non-integer \fIvalue\fR or \fIpattern\fR (other
+than a final \fBdefault\fR) into an error.
+.VE 9.1
 .\" OPTION: -regexp
 .TP 10
 \fB\-regexp\fR
 .
-When matching \fIstring\fR to the patterns, use regular
+When matching \fIvalue\fR to the patterns, use regular
 expression matching
 (as described in the \fBre_syntax\fR reference page).
 .\" OPTION: -nocase
 .TP 10
 \fB\-nocase\fR
 .
 Causes comparisons to be handled in a case-insensitive manner.
+Not supported with the \fB\-integer\fR option.
 .\" OPTION: -matchvar
 .TP 10
 \fB\-matchvar\fI varName\fR
@@ -67,7 +77,7 @@ This option (only legal when \fB\-regexp\fR is also specified)
 specifies the name of a variable into which the list of matches
 found by the regular expression engine will be written.  The first
 element of the list written will be the overall substring of the input
-string (i.e. the \fIstring\fR argument to \fBswitch\fR) matched, the
+string (i.e. the \fIvalue\fR argument to \fBswitch\fR) matched, the
 second element of the list will be the substring matched by the first
 capturing parenthesis in the regular expression that matched, and so
 on.  When a \fBdefault\fR branch is taken, the variable will have the
@@ -84,7 +94,7 @@ found by the regular expression engine will be written.  The first
 element of the list written will be a two-element list specifying the
 index of the start and index of the first character after the end of
 the overall substring of the input
-string (i.e. the \fIstring\fR argument to \fBswitch\fR) matched, in a
+string (i.e. the \fIvalue\fR argument to \fBswitch\fR) matched, in a
 similar way to the \fB\-indices\fR option to the \fBregexp\fR can
 obtain.  Similarly, the second element of the list refers to the first
 capturing parenthesis in the regular expression that matched, and so
@@ -96,7 +106,7 @@ time as the \fB\-matchvar\fR option.
 \fB\-\|\-\fR
 .
 Marks the end of options.  The argument following this one will
-be treated as \fIstring\fR even if it starts with a \fB\-\fR.
+be treated as \fIvalue\fR even if it starts with a \fB\-\fR.
 This is not required when the matching patterns and bodies are grouped
 together in a single argument.
 .PP
@@ -184,6 +194,26 @@ exactly matched is easily obtained using the \fB\-matchvar\fR option:
     }
 }
 .CE
+.PP
+.VS 9.1
+Deciding what to do with a procedure based on the number of arguments:
+.PP
+.CS
+proc example args {
+    \fBswitch\fR -integer -- [llength $args] {
+        0 {
+            puts "no arguments"
+        }
+        1 {
+            puts "one argument: [lindex $args 0]"
+        }
+        default {
+            puts "many arguments: $args"
+        }
+    }
+}
+.CE
+.VE 9.1
 .SH "SEE ALSO"
 for(n), if(n), regexp(n)
 .SH KEYWORDS

generic/tclCmdMZ.c

@@ -3452,9 +3452,10 @@ TclNRSwitchObjCmd(
     int noCase;
     Tcl_Size patternLength, j;
     const char *pattern;
-    Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
+    Tcl_Obj *valueObj, *indexVarObj, *matchVarObj;
     Tcl_Obj *const *savedObjv = objv;
     Tcl_RegExp regExpr = NULL;
+    Tcl_WideInt intValue = 0, armValue;
     Interp *iPtr = (Interp *) interp;
     int pc = 0;
     int bidx = 0;		/* Index of body argument. */
@@ -3468,12 +3469,12 @@ TclNRSwitchObjCmd(
      */
 
     static const char *const options[] = {
-	"-exact", "-glob", "-indexvar", "-matchvar", "-nocase", "-regexp",
-	"--", NULL
+	"-exact", "-glob", "-indexvar", "-integer", "-matchvar", "-nocase",
+	"-regexp", "--", NULL
     };
     enum switchOptionsEnum {
-	OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP,
-	OPT_LAST
+	OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_INTEGER, OPT_MATCHV, OPT_NOCASE,
+	OPT_REGEXP, OPT_LAST
     } index;
     typedef int (*strCmpFn_t)(const char *, const char *);
     strCmpFn_t strCmpFn = TclUtfCmp;
@@ -3580,8 +3581,15 @@ TclNRSwitchObjCmd(
 		"MODERESTRICTION", (char *)NULL);
 	return TCL_ERROR;
     }
+    if (noCase && mode == OPT_INTEGER) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"-nocase option cannot be used with -integer option"));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+		"MODERESTRICTION", (char *)NULL);
+	return TCL_ERROR;
+    }
 
-    stringObj = objv[i];
+    valueObj = objv[i];
     objc -= i + 1;
     objv += i + 1;
     bidx = i + 1;		/* First after the match string. */
@@ -3673,6 +3681,12 @@ TclNRSwitchObjCmd(
 	return TCL_ERROR;
     }
 
+    if (mode == OPT_INTEGER) {
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &intValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+
     for (i = 0; i < objc; i += 2) {
 	/*
 	 * See if the pattern matches the string.
@@ -3712,12 +3726,12 @@ TclNRSwitchObjCmd(
 
 	switch (mode) {
 	case OPT_EXACT:
-	    if (strCmpFn(TclGetString(stringObj), pattern) == 0) {
+	    if (strCmpFn(TclGetString(valueObj), pattern) == 0) {
 		goto matchFound;
 	    }
 	    break;
 	case OPT_GLOB:
-	    if (Tcl_StringCaseMatch(TclGetString(stringObj),pattern,noCase)) {
+	    if (Tcl_StringCaseMatch(TclGetString(valueObj),pattern,noCase)) {
 		goto matchFound;
 	    }
 	    break;
@@ -3727,7 +3741,7 @@ TclNRSwitchObjCmd(
 	    if (regExpr == NULL) {
 		return TCL_ERROR;
 	    } else {
-		int matched = Tcl_RegExpExecObj(interp, regExpr, stringObj, 0,
+		int matched = Tcl_RegExpExecObj(interp, regExpr, valueObj, 0,
 			numMatchesSaved, 0);
 
 		if (matched < 0) {
@@ -3737,6 +3751,13 @@ TclNRSwitchObjCmd(
 		}
 	    }
 	    break;
+	case OPT_INTEGER:
+	    if (Tcl_GetWideIntFromObj(interp, objv[i], &armValue) != TCL_OK) {
+		return TCL_ERROR;
+	    } else if (intValue == armValue) {
+		goto matchFound;
+	    }
+	    break;
 	}
     }
     return TCL_OK;
@@ -3786,7 +3807,7 @@ TclNRSwitchObjCmd(
 		Tcl_Obj *substringObj;
 
 		if (info.matches[j].end > 0) {
-		    substringObj = Tcl_GetRange(stringObj,
+		    substringObj = Tcl_GetRange(valueObj,
 			    info.matches[j].start, info.matches[j].end-1);
 		} else {
 		    TclNewObj(substringObj);