Fixed two faults with [unset -nocomplain]; one with a possible overrun

of the argument array, and another with the documentation.


FossilOrigin-Name: 308102bafc14cee55bb361a5dd1f8c84203a7f94

4 files changed, 34 insertions, 18 deletions

diff --git a/ChangeLog b/ChangeLog
index 06cc918..56befdb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2001-03-06  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* generic/tclVar.c (Tcl_UnsetObjCmd): Rewrote argument parser to
+	avoid a read off the end of the argument array that could occur
+	when executing something like [unset -nocomplain] was executed.
+	Improved the error message given when too few arguments are given
+	(-nocomplain should obviously be *before* --, not after it) and
+	also modified the test suite to take account of that and the
+	documentation to use the same improvement.
+
 2001-03-02  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
 	* generic/tclExecute.c (TclExecuteByteCode): Fixed bug that could
diff --git a/doc/unset.n b/doc/unset.n
index 71af4a5..ed73434 100644
--- a/doc/unset.n
+++ b/doc/unset.n
@@ -6,7 +6,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: unset.n,v 1.4 2000/09/07 14:27:52 poenitz Exp $
+'\" RCS: @(#) $Id: unset.n,v 1.5 2001/03/06 14:45:03 dkf Exp $
 '\" 
 .so man.macros
 .TH unset n 8.4 Tcl "Tcl Built-In Commands"
@@ -15,7 +15,7 @@
 .SH NAME
 unset \- Delete variables
 .SH SYNOPSIS
-\fBunset \fR?\fI\-\-\fR? ?\fI\-nocomplain\fR? ?\fIname name name ...\fR?
+\fBunset \fR?\fI\-nocomplain\fR? ?\fI\-\-\fR? ?\fIname name name ...\fR?
 .BE
 
 .SH DESCRIPTION
@@ -31,9 +31,9 @@ The \fBunset\fR command returns an empty string as result.
 .VS 8.4
 If \fI\-nocomplain\fR is specified as the first argument, any possible
 errors are suppressed.  The option may not be abbreviated, in order to
-disambiguate it from possible variable names.  \fI\-\-\fR may be specified
-prior to \fI\-nocomplain\fR to prevent it from being interpreted as an
-option.
+disambiguate it from possible variable names.  The option \fI\-\-\fR
+indicates the end of the options, and should be used if you wish to
+remove a variable with the same name as any of the options.
 .VE 8.4
 If an error occurs, any variables after the named one causing the error not
 deleted.  An error can occur when the named variable doesn't exist, or the
diff --git a/generic/tclVar.c b/generic/tclVar.c
index c160c84..608185e 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.27 2000/11/17 11:06:53 dkf Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.28 2001/03/06 14:45:03 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2611,23 +2611,29 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv)
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"?--? ?-nocomplain? ?varName varName ...?");
+		"?-nocomplain? ?--? ?varName varName ...?");
 	return TCL_ERROR;
     }
 
     /*
-     * Very simple, restrictive argument parsing.  The only options are
-     * -- and -nocomplain (which must come first to be an option).
+     * Simple, restrictive argument parsing.  The only options are --
+     * and -nocomplain (which must come first and be given exactly to
+     * be an option).
      */
     i = 1;
     name = TclGetString(objv[i]);
-    if ((name[0] == '-') && (strcmp("-nocomplain", name) == 0)) {
-	flags = 0;
-	i++;
-	name = TclGetString(objv[i]);
-    }
-    if ((name[0] == '-') && (strcmp("--", name) == 0)) {
-	i++;
+    if (name[0] == '-') {
+ 	if (strcmp("-nocomplain", name) == 0) {
+	    i++;
+ 	    if (i == objc) {
+		return TCL_OK;
+	    }
+ 	    flags = 0;
+ 	    name = TclGetString(objv[i]);
+ 	}
+ 	if (strcmp("--", name) == 0) {
+ 	    i++;
+ 	}
     }
 
     for (; i < objc;  i++) {
diff --git a/tests/set-old.test b/tests/set-old.test
index 6a63200..1cf6aba 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: set-old.test,v 1.12 2000/08/21 01:37:51 ericm Exp $
+# RCS: @(#) $Id: set-old.test,v 1.13 2001/03/06 14:45:03 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -204,7 +204,7 @@ test set-old-7.1 {unset command} {
 } {0 0 0 1}
 test set-old-7.2 {unset command} {
     list [catch {unset} msg] $msg
-} {1 {wrong # args: should be "unset ?--? ?-nocomplain? ?varName varName ...?"}}
+} {1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName varName ...?"}}
 test set-old-7.3 {unset command} {
     catch {unset a}
     list [catch {unset a} msg] $msg