* generic/tclPkg.c (CompareVersions): Bugfix. Check string lengths

	* tests/pkg.test: before comparison. The shorter string is the
	  smaller number. Added testcases as well. Interestingly all
	  existing test cases for vcompare compared numbers of the same
	  length with each other. See [SF Tcl Bug 1563836].

3 files changed, 31 insertions, 13 deletions

diff --git a/ChangeLog b/ChangeLog
index de9e314..e809265 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,15 @@
+2006-09-28  Andreas Kupries  <andreask@activestate.com>
+
+	* generic/tclPkg.c (CompareVersions): Bugfix. Check string lengths
+	* tests/pkg.test: before comparison. The shorter string is the
+	  smaller number. Added testcases as well. Interestingly all
+	  existing test cases for vcompare compared numbers of the same
+	  length with each other. See [SF Tcl Bug 1563836].
+
 2006-09-28  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclIO.c (Tcl_GetsObj): added two test'n'panic guards for
-	possible NULL derefs, [Bug 1566382] and coverity #33.
+	  possible NULL derefs, [Bug 1566382] and coverity #33.
 
 2006-09-27  Don Porter  <dgp@users.sourceforge.net>
 
@@ -13,7 +21,7 @@
 	math::bigfloat package [Bug 1567222]
 
 	* generic/tclPkg.c (CompareVersion):	Flatten strcmp() results to
-	{-1, 0, 1} to match expectations of CompareVersion() callers.
+	  {-1, 0, 1} to match expectations of CompareVersion() callers.
 
 2006-09-27  Miguel Sofer  <msofer@users.sf.net>
 
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 25c044c..d2952a0 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclPkg.c,v 1.18 2006/09/28 15:10:25 dgp Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.19 2006/09/28 20:54:45 andreas_kupries Exp $
  *
  * TIP #268.
  * Heavily rewritten to handle the extend version numbers, and extended
@@ -1383,18 +1383,26 @@ CompareVersions(
 	e2 = s2; while ((*e2 != 0) && (*e2 != ' ')) { e2 ++; }
 
 	/*
-	 * s1 .. e1 and s2 .. e2 now bracket the numbers to compare.
-	 * Insert terminators, compare, and restore actual contents.
+	 * s1 .. e1 and s2 .. e2 now bracket the numbers to compare. Insert
+	 * terminators, compare, and restore actual contents.  First however
+	 * another shortcut. Compare lengths. Shorter string is smaller
+	 * number! Thus we strcmp only strings of identical length.
 	 */
 
-	o1 = *e1 ; *e1 = '\0';
-	o2 = *e2 ; *e2 = '\0';
+	if ((e1-s1) < (e2-s2)) {
+	    res = -1;
+	} else if ((e2-s2) < (e1-s1)) {
+	    res = 1;
+	} else {
+	    o1 = *e1 ; *e1 = '\0';
+	    o2 = *e2 ; *e2 = '\0';
 
-	res = strcmp (s1, s2);
-	res = (res < 0) ? -1 : (res ? 1 : 0);
+	    res = strcmp (s1, s2);
+	    res = (res < 0) ? -1 : (res ? 1 : 0);
 
-	*e1 = o1;
-	*e2 = o2;
+	    *e1 = o1;
+	    *e2 = o2;
+	}
 
 	/*
 	 * Stop comparing segments when a difference has been found. Here we
diff --git a/tests/pkg.test b/tests/pkg.test
index ee1c839..2bf1ebe 100644
--- a/tests/pkg.test
+++ b/tests/pkg.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: pkg.test,v 1.18 2006/09/27 20:22:40 andreas_kupries Exp $
+# RCS: @(#) $Id: pkg.test,v 1.19 2006/09/28 20:54:46 andreas_kupries Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -946,6 +946,9 @@ foreach {r p vs vc} {
     8.5.0    8.6a0    1          -1
     8.5.0    8.6b0    1          -1
     8.5.0    8.6.0    1          -1
+    10       8        0          1
+    8        10       0          -1
+    0.0.1.2  0.1.2    1          -1
 } {
     test package-vsatisfies-1.$n {package vsatisfies} {
 	package vsatisfies $p $r
@@ -962,7 +965,6 @@ test package-vcompare-2.0 {package vcompare at 32bit boundary} {
     package vcompare [expr {1<<31}] [expr {(1<<31)-1}]
 } 1
 
-
 set n 0
 foreach {required provided satisfied} {
     8.5a0-   8.5a5    1