Simplify -matchvar/-indexvar processing of regexp/switch

generic/tclCmdMZ.c

@@ -384,15 +384,20 @@ Tcl_RegexpObjCmd(
 		    if (end >= offset) {
 			end--;
 		    }
+		    TclNewIntObj(objs[0], start);
+		    TclNewIntObj(objs[1], end);
+
+		    newPtr = Tcl_NewListObj(2, objs);
 		} else {
-		    start = -1;
-		    end = -1;
+		    start = TCL_INDEX_NONE;
+		    end = TCL_INDEX_NONE;
+		    TclNewObj(newPtr);
+#if TCL_MAJOR_VERSION < 9 && !defined(TCL_NO_DEPRECATED)
+		    Tcl_ListObjAppendElement(NULL, newPtr, Tcl_NewIntObj(-1));
+		    Tcl_ListObjAppendElement(NULL, newPtr, Tcl_NewIntObj(-1));
+#endif
 		}
 
-		TclNewIntObj(objs[0], start);
-		TclNewIntObj(objs[1], end);
-
-		newPtr = Tcl_NewListObj(2, objs);
 	    } else {
 		if (i <= info.nsubs) {
 		    newPtr = Tcl_GetRange(objPtr,
@@ -3780,17 +3785,22 @@ TclNRSwitchObjCmd(
 		if (info.matches[j].end > 0) {
 		    TclNewIntObj(rangeObjAry[0], info.matches[j].start);
 		    TclNewIntObj(rangeObjAry[1], info.matches[j].end-1);
+		    Tcl_ListObjAppendElement(NULL, indicesObj,
+			    Tcl_NewListObj(2, rangeObjAry));
 		} else {
-		    TclNewIntObj(rangeObjAry[1], TCL_INDEX_NONE);
-		    rangeObjAry[0] = rangeObjAry[1];
+		    TclNewObj(rangeObjAry[0]);
+#if TCL_MAJOR_VERSION < 9 && !defined(TCL_NO_DEPRECATED)
+		    Tcl_ListObjAppendElement(NULL, rangeObjAry[0], Tcl_NewIntObj(-1));
+		    Tcl_ListObjAppendElement(NULL, rangeObjAry[0], Tcl_NewIntObj(-1));
+#endif
+		    Tcl_ListObjAppendElement(NULL, indicesObj,
+			    rangeObjAry[0]);
 		}
 
 		/*
 		 * Never fails; the object is always clean at this point.
 		 */
 
-		Tcl_ListObjAppendElement(NULL, indicesObj,
-			Tcl_NewListObj(2, rangeObjAry));
 	    }
 
 	    if (matchVarObj != NULL) {

generic/tclListObj.c

@@ -1441,11 +1441,12 @@ TclLsetList(
     /*
      * Determine whether the index arg designates a list or a single index.
      * We have to be careful about the order of the checks to avoid repeated
-     * shimmering; see TIP #22 and #23 for details.
+     * shimmering; see TIP #22 and #23 for details. Don't allow "" as single
+     * index here, since it cannot be distinguished from an empty list.
      */
 
     ListGetInternalRep(indexArgPtr, listRepPtr);
-    if (listRepPtr == NULL
+    if (listRepPtr == NULL && Tcl_GetString(indexArgPtr)[0]
 	    && TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX - 1, &index) == TCL_OK) {
 	/*
 	 * indexArgPtr designates a single index.

generic/tclUtil.c

@@ -3768,6 +3768,11 @@ GetEndOffsetFromObj(
 
 	    /* Value doesn't start with "e" */
 
+	    if (length == 0) {
+		offset = WIDE_MIN;
+		goto parseOK;
+	    }
+
 	    /* If we reach here, the string rep of objPtr exists. */
 
 	    /*

tests/lpop.test

@@ -46,7 +46,7 @@ test lpop-1.6 {error conditions} -returnCodes error -body {
 test lpop-1.7 {error conditions} -returnCodes error -body {
     set l "x y"
     lpop l {}
-} -match glob -result {bad index *}
+} -result {index "" out of range}
 test lpop-1.8 {error conditions} -returnCodes error -body {
     set l "x y"
     lpop l 0 0 0 0 1

tests/regexp.test

@@ -17,7 +17,15 @@ if {"::tcltest" ni [namespace children]} {
 }
 
 unset -nocomplain foo
+::tcltest::loadTestedCommands
 package require tcltests
+
+if {[testConstraint nodep]} {
+    set emptyMatch {-1 -1}
+} else {
+    set emptyMatch {}
+}
+
 testConstraint exec [llength [info commands exec]]
 
 # Used for constraining memory leak tests
@@ -187,11 +195,11 @@ test regexp-3.5 {-indices option to regexp} {
 test regexp-3.6 {getting substrings back from regexp} {
     set foo 2; set f2 2; set f3 2; set f4 2
     list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
-} {1 {1 1} {1 1} {-1 -1} {-1 -1}}
+} [list 1 {1 1} {1 1} $emptyMatch $emptyMatch]
 test regexp-3.7 {getting substrings back from regexp} {
     set foo 1; set f2 1; set f3 1; set f4 1
     list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
-} {1 {1 2} {1 1} {-1 -1} {2 2}}
+} [list 1 {1 2} {1 1} $emptyMatch {2 2}]
 test regexp-3.8a {-indices by multi-byte utf-8} {
     regexp -inline -indices {(\w+)-(\w+)} \
 	"grüß-привет"
@@ -752,7 +760,7 @@ test regexp-18.11 {regexp -all} {
 } {a}
 test regexp-18.12 {regexp -all -inline -indices} {
     regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh
-} {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}}
+} [list {0 4} {1 3} {2 2} $emptyMatch {5 9} {6 8} $emptyMatch {7 7}]
 
 test regexp-19.1 {regsub null replacement} {
     regsub -all {@} {@hel@lo@} "\0a\0" result

tests/regexpComp.test

@@ -15,9 +15,15 @@ if {"::tcltest" ni [namespace children]} {
     package require tcltest 2.5
     namespace import -force ::tcltest::*
 }
-
+::tcltest::loadTestedCommands
 package require tcltests
 
+if {[testConstraint nodep]} {
+    set emptyMatch {-1 -1}
+} else {
+    set emptyMatch {}
+}
+
 # Procedure to evaluate a script within a proc, to test compilation
 # functionality
 
@@ -228,13 +234,13 @@ test regexpComp-3.6 {getting substrings back from regexp} {
 	set foo 2; set f2 2; set f3 2; set f4 2
 	list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
     }
-} {1 {1 1} {1 1} {-1 -1} {-1 -1}}
+} [list 1 {1 1} {1 1} $emptyMatch $emptyMatch]
 test regexpComp-3.7 {getting substrings back from regexp} {
     evalInProc {
 	set foo 1; set f2 1; set f3 1; set f4 1
 	list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
     }
-} {1 {1 2} {1 1} {-1 -1} {2 2}}
+} [list 1 {1 2} {1 1} $emptyMatch {2 2}]
 
 test regexpComp-4.1 {-nocase option to regexp} {
     evalInProc {
@@ -784,7 +790,7 @@ test regexpComp-18.12 {regexp -all -inline -indices} {
     evalInProc {
 	regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh
     }
-} {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}}
+} [list {0 4} {1 3} {2 2} $emptyMatch {5 9} {6 8} $emptyMatch {7 7}]
 
 test regexpComp-19.1 {regsub null replacement} {
     evalInProc {

tests/switch.test

@@ -15,7 +15,15 @@ if {"::tcltest" ni [namespace children]} {
     package require tcltest 2.5
     namespace import -force ::tcltest::*
 }
-
+::tcltest::loadTestedCommands
+package require tcltests
+
+if {[testConstraint nodep]} {
+    set emptyMatch {-1 -1}
+} else {
+    set emptyMatch {}
+}
+
 test switch-1.1 {simple patterns} {
     switch a a {subst 1} b {subst 2} c {subst 3} default {subst 4}
 } 1
@@ -569,7 +577,7 @@ test switch-12.8 {-indexvar and matched empty strings} {
 } {{0 2} {3 2}}
 test switch-12.9 {-indexvar and unmatched strings} {
     switch -regexp -indexvar x -- abcdef ^...(x)? {return $x}
-} {{0 2} {-1 -1}}
+} [list {0 2} $emptyMatch]
 
 test switch-13.1 {-indexvar -matchvar combinations} {
     switch -regexp -indexvar x -matchvar y abc {

tests/util.test

@@ -696,7 +696,7 @@ test util-9.18 {Tcl_GetIntForIndex} {
 } b
 test util-9.19 {Tcl_GetIntForIndex} -body {
     string index a {}
-} -returnCodes error -match glob -result *
+} -result {}
 test util-9.20 {Tcl_GetIntForIndex} -body {
     string index a { }
 } -returnCodes error -match glob -result *