Dpkg::Version fix and test-suite adjustment

* scripts/t/900_Dpkg_Version.t: Renamed into...
* scripts/t/100_Dpkg_Version.t: and merged test cases previously
provided by this file so that there's no loss of tests. Also
adjusted test cases to match the change below.
* scripts/Dpkg/Version.pm (compare_versions): Handle "<" like "<="
and ">" like ">=" in order to be consistent with dpkg
--compare-versions. Emit warnings when they are used as they are
deprecated.
* scripts/Makefile.am: Drop scripts/t/900_Dpkg_Version.t from the
set of extra files to distribute.
* scripts/dpkg-genchanges.pl: Use "<<" instead of ambiguous "<" in
version comparison.

ChangeLog

@@ -1,3 +1,18 @@
+2009-01-27  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/t/900_Dpkg_Version.t: Renamed into...
+	* scripts/t/100_Dpkg_Version.t: and merged test cases previously
+	provided by this file so that there's no loss of tests. Also
+	adjusted test cases to match the change below.
+	* scripts/Dpkg/Version.pm (compare_versions): Handle "<" like "<="
+	and ">" like ">=" in order to be consistent with dpkg
+	--compare-versions. Emit warnings when they are used as they are
+	deprecated.
+	* scripts/Makefile.am: Drop scripts/t/900_Dpkg_Version.t from the
+	set of extra files to distribute.
+	* scripts/dpkg-genchanges.pl: Use "<<" instead of ambiguous "<" in
+	version comparison.
+
 2009-01-22  Guillem Jover  <guillem@debian.org>
 
 	* lib/log.c (statusfd_send): Use varbufsubstc to replace new lines

scripts/Dpkg/Version.pm

@@ -180,15 +180,18 @@ sub compare_versions ($$$)
     my $rel = $_[1];
     my $res = vercmp($_[0], $_[2]);
 
-    if ($rel eq 'gt' or $rel eq ">" or $rel eq ">>") {
+    warning("operator %s is deprecated in compare_versions(): use %s or %s",
+            $rel, "$rel$rel", "$rel=") if ($rel eq '>' or $rel eq '<');
+
+    if ($rel eq 'gt' or $rel eq '>>') {
 	return $res > 0;
-    } elsif ($rel eq 'ge' or $rel eq '>=') {
+    } elsif ($rel eq 'ge' or $rel eq '>=' or $rel eq '>') {
 	return $res >= 0;
     } elsif ($rel eq 'eq' or $rel eq '=') {
 	return $res == 0;
-    } elsif ($rel eq 'le' or $rel eq '<=') {
+    } elsif ($rel eq 'le' or $rel eq '<=' or $rel eq '<') {
 	return $res <= 0;
-    } elsif ($rel eq 'lt' or $rel eq "<" or $rel eq "<<") {
+    } elsif ($rel eq 'lt' or $rel eq '<<') {
 	return $res < 0;
     } else {
 	die "bad relation '$rel'";

scripts/Makefile.am

@@ -78,8 +78,7 @@ EXTRA_DIST = \
 	t/600_Dpkg_Changelog/shadow \
 	t/700_Dpkg_Control.t \
 	t/700_Dpkg_Control/control-1 \
-	t/800_Dpkg_IPC.t \
-	t/900_Dpkg_Version.t
+	t/800_Dpkg_IPC.t
 
 CLEANFILES = \
 	$(bin_SCRIPTS) $(sbin_SCRIPTS) $(changelog_SCRIPTS) \

scripts/dpkg-genchanges.pl

@@ -208,7 +208,7 @@ $substvars->set_version_substvars($changelog->{"Version"});
 $substvars->parse($varlistfile) if -e $varlistfile;
 
 if (defined($prev_changelog) and
-    compare_versions($changelog->{"Version"}, '<', $prev_changelog->{"Version"})) {
+    compare_versions($changelog->{"Version"}, '<<', $prev_changelog->{"Version"})) {
     warning(_g("the current version (%s) is smaller than the previous one (%s)"),
 	$changelog->{"Version"}, $prev_changelog->{"Version"});
 }

scripts/t/100_Dpkg_Version.t

@@ -1,80 +1,104 @@
 # -*- mode: cperl;-*-
 
 use Test::More;
+use Dpkg::ErrorHandling qw($quiet_warnings);
+
+$quiet_warnings = 1;
 
-use warnings;
 use strict;
+use warnings;
 
-# Default cmp '>'
-my @versions = ({a      => '1.0-1',
-		 b      => '2.0-2',
-		 result => -1,
-		 relation => 'lt',
-		},
-		{a      => '2.2~rc-4',
-		 b      => '2.2-1',
-		 result => -1,
-		 relation => 'lt',
-		},
-		{a      => '2.2-1',
-		 b      => '2.2~rc-4',
-		 result => 1,
-		 relation => 'gt',
-		},
-		{a      => '1.0000-1',
-		 b      => '1.0-1',
-		 result => 0,
-		 relation => 'eq',
-		},
-		{a      => '1.0000-1',
-		 b      => '1.0-1',
-		 result => 0,
-		 relation => 'ge',
-		},
-		{a      => '1',
-		 b      => '0:1',
-		 result => 0,
-		 relation => 'eq',
-		},
-		{a      => '2:2.5',
-		 b      => '1:7.5',
-		 result => 1,
-		 relation => 'gt',
-		},
-	       );
-my @test_failure = ({a      => '1.0-1',
-		     b      => '2.0-2',
-		     relation => 'gt',
-		    },
-		    {a      => '2.2~rc-4',
-		     b      => '2.2-1',
-		     relation => 'eq',
-		    },
-		   );
+my @tests = <DATA>;
+my @ops = ("<", "<<", "lt",
+	   "<=", "le",
+	   "=", "eq",
+	   ">=", "ge",
+	   ">", ">>", "gt");
 
-plan tests => @versions * 3 + @test_failure * 2 + 1;
+plan tests => scalar(@tests) * (2 * scalar(@ops) + 1) + 1;
 
-sub dpkg_vercmp{
-     my ($a,$b,$cmp) = @_;
-     $cmp = 'gt' if not defined $cmp;
-     return system('dpkg','--compare-versions',$a,$cmp,$b) == 0;
+sub dpkg_vercmp {
+     my ($a, $cmp, $b) = @_;
+     return system('dpkg', '--compare-versions', $a, $cmp, $b) == 0;
 }
 
+use_ok('Dpkg::Version', qw(vercmp compare_versions));
 
-use_ok('Dpkg::Version');
+my $truth = {
+    "-1" => {
+	"<<" => 1, "lt" => 1,
+	"<=" => 1, "le" => 1, "<" => 1,
+	"=" => 0, "eq" => 0,
+	">=" => 0, "ge" => 0, ">" => 0,
+	">>" => 0, "gt" => 0,
+    },
+    "0" => {
+	"<<" => 0, "lt" => 0,
+	"<=" => 1, "le" => 1, "<" => 1,
+	"=" => 1, "eq" => 1,
+	">=" => 1, "ge" => 1, ">" => 1,
+	">>" => 0, "gt" => 0,
+    },
+    "1" => {
+	"<<" => 0, "lt" => 0,
+	"<=" => 0, "le" => 0, "<" => 0,
+	"=" => 0, "eq" => 0,
+	">=" => 1, "ge" => 1, ">" => 1,
+	">>" => 1, "gt" => 1,
+    },
+};
 
-for my $version_cmp (@versions) {
-     ok(Dpkg::Version::vercmp($$version_cmp{a},$$version_cmp{b}) == $$version_cmp{result},
-	"vercmp: Version $$version_cmp{a} $$version_cmp{relation} $$version_cmp{b} ok");
-     ok(Dpkg::Version::compare_versions($$version_cmp{a},$$version_cmp{relation},$$version_cmp{b}),
-       "compare_versions: Version $$version_cmp{a} $$version_cmp{relation} $$version_cmp{b} ok");
-     ok(dpkg_vercmp($$version_cmp{a},$$version_cmp{b},$$version_cmp{relation}),
-	"Dpkg concures: Version $$version_cmp{a} $$version_cmp{relation} $$version_cmp{b}");
+foreach my $case (@tests) {
+    my ($a, $b, $res) = split " ", $case;
+    is(vercmp($a, $b), $res, "$a cmp $b => $res");
+    foreach my $op (@ops) {
+	if ($truth->{$res}{$op}) {
+	    ok(compare_versions($a, $op, $b), "$a $op $b => true");
+	    ok(dpkg_vercmp($a, $op, $b), "dpkg --compare-versions $a $op $b => true");
+	} else {
+	    ok(!compare_versions($a, $op, $b), "$a $op $b => false");
+	    ok(!dpkg_vercmp($a, $op, $b), "dpkg --compare-versions $a $op $b => false");
+	}
+    }
 }
 
-for my $version_cmp (@test_failure) {
-     ok(!Dpkg::Version::compare_versions($$version_cmp{a},$$version_cmp{relation},$$version_cmp{b}),
-       "compare_versions: Version $$version_cmp{a} $$version_cmp{relation} $$version_cmp{b} false");
-     ok(!dpkg_vercmp($$version_cmp{a},$$version_cmp{b},$$version_cmp{relation}),
-	"Dpkg concures: Version $$version_cmp{a} $$version_cmp{relation} $$version_cmp{b}");
-}
+__DATA__
+1.0-1 2.0-2 -1
+2.2~rc-4 2.2-1 -1
+2.2-1 2.2~rc-4 1
+1.0000-1 1.0-1 0
+1 0:1 0
+2:2.5 1:7.5 1
+1:foo foo 1
+0:foo foo 0
+foo foo 0
+foo- foo 0
+foo fo 1
+foo- foo+ -1
+foo~1 foo -1
+foo~foo+Bar foo~foo+bar -1
+foo~~ foo~ -1
+12345+that-really-is-some-ver-0 12345+that-really-is-some-ver-10 -1
+foo-0 foo-01 -1
+foo.bar foobar 1
+foo.bar foo1bar 1
+foo.bar foo0bar 1
+1foo-1 foo-1 -1
+foo2.0 foo2 1
+foo2.0.0 foo2.10.0 -1
+foo2.0 foo2.0.0 -1
+foo2.0 foo2.10 -1
+foo2.1 foo2.10 -1
+1.09 1.9 0
+1.0.8+nmu1 1.0.8 1
+3.11 3.10+nmu1 1
+0.9j-20080306-4 0.9i-20070324-2 1
+1.2.0~b7-1 1.2.0~b6-1 1
+1.011-1 1.06-2 1
+0.0.9+dfsg1-1 0.0.8+dfsg1-3 1
+4.6.99+svn6582-1 4.6.99+svn6496-1 1
+53 52 1
+0.9.9~pre122-1 0.9.9~pre111-1 1
+2:2.3.2-2+lenny2 2:2.3.2-2 1
+1:3.8.1-1 3.8.GA-1 1
+1.0.1+gpl-1 1.0.1-2 1

scripts/t/900_Dpkg_Version.t

@@ -1,88 +0,0 @@
-# -*- mode: cperl;-*-
-
-use Test::More;
-
-use strict;
-use warnings;
-
-my @tests = <DATA>;
-my @ops = ("<", "<<", "lt",
-	   "<=", "le",
-	   "=", "eq",
-	   ">=", "ge",
-	   ">", ">>", "gt");
-
-plan tests => scalar(@tests) * (scalar(@ops) + 1) + 1;
-
-use_ok('Dpkg::Version', qw(vercmp compare_versions));
-
-my $truth = {
-    "-1" => {
-	"<" => 1, "<<" => 1, "lt" => 1,
-	"<=" => 1, "le" => 1,
-	"=" => 0, "eq" => 0,
-	">=" => 0, "ge" => 0,
-	">" => 0, ">>" => 0, "gt" => 0,
-    },
-    "0" => {
-	"<" => 0, "<<" => 0, "lt" => 0,
-	"<=" => 1, "le" => 1,
-	"=" => 1, "eq" => 1,
-	">=" => 1, "ge" => 1,
-	">" => 0, ">>" => 0, "gt" => 0,
-    },
-    "1" => {
-	"<" => 0, "<<" => 0, "lt" => 0,
-	"<=" => 0, "le" => 0,
-	"=" => 0, "eq" => 0,
-	">=" => 1, "ge" => 1,
-	">" => 1, ">>" => 1, "gt" => 1,
-    },
-};
-
-foreach my $case (@tests) {
-    my ($a, $b, $res) = split " ", $case;
-    is(vercmp($a, $b), $res, "$a cmp $b => $res");
-    foreach my $op (@ops) {
-	if ($truth->{$res}{$op}) {
-	    ok(compare_versions($a, $op, $b), "$a $op $b => true");
-	} else {
-	    ok(!compare_versions($a, $op, $b), "$a $op $b => false");
-	}
-    }
-}
-
-__DATA__
-1:foo foo 1
-0:foo foo 0
-foo foo 0
-foo- foo 0
-foo fo 1
-foo- foo+ -1
-foo~1 foo -1
-foo~foo+Bar foo~foo+bar -1
-foo~~ foo~ -1
-12345+that-really-is-some-ver-0 12345+that-really-is-some-ver-10 -1
-foo-0 foo-01 -1
-foo.bar foobar 1
-foo.bar foo1bar 1
-foo.bar foo0bar 1
-1foo-1 foo-1 -1
-foo2.0 foo2 1
-foo2.0.0 foo2.10.0 -1
-foo2.0 foo2.0.0 -1
-foo2.0 foo2.10 -1
-foo2.1 foo2.10 -1
-1.09 1.9 0
-1.0.8+nmu1 1.0.8 1
-3.11 3.10+nmu1 1
-0.9j-20080306-4 0.9i-20070324-2 1
-1.2.0~b7-1 1.2.0~b6-1 1
-1.011-1 1.06-2 1
-0.0.9+dfsg1-1 0.0.8+dfsg1-3 1
-4.6.99+svn6582-1 4.6.99+svn6496-1 1
-53 52 1
-0.9.9~pre122-1 0.9.9~pre111-1 1
-2:2.3.2-2+lenny2 2:2.3.2-2 1
-1:3.8.1-1 3.8.GA-1 1
-1.0.1+gpl-1 1.0.1-2 1