From d90810ffc98b821d57a44bbc3f105b474a8b0fa3 Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Sun, 25 Jun 2006 18:00:59 -0700 Subject: [PATCH] * Fix Debbugs::Versions::Dpkg to deal with ~ in the versions properly * Add tests in 02_version_dpkg.t to actually test to make sure that Debbugs::Versions::Dpkg and dpkg --compare-versions agree what the version relationships are. --- Debbugs/Versions/Dpkg.pm | 116 +++++++++++++++++++++++++-------------- t/02_version_dpkg.t | 51 +++++++++++++++++ 2 files changed, 125 insertions(+), 42 deletions(-) create mode 100644 t/02_version_dpkg.t diff --git a/Debbugs/Versions/Dpkg.pm b/Debbugs/Versions/Dpkg.pm index 064618f..e061b34 100644 --- a/Debbugs/Versions/Dpkg.pm +++ b/Debbugs/Versions/Dpkg.pm @@ -46,41 +46,77 @@ sub parseversion ($) return %verhash; } -sub verrevcmp ($$) +# verrevcmp + +# This function is almost exactly equivalent +# to dpkg's verrevcmp function, including the +# order subroutine which it uses. + +sub verrevcmp($$) { - my ($val, $ref) = @_; - for (;;) - { - $val =~ s/^(\D*)//; - my $alphaval = $1; - $ref =~ s/^(\D*)//; - my $alpharef = $1; - if (length $alphaval or length $alpharef) - { - my @avsplit = split //, $alphaval; - my @arsplit = split //, $alpharef; - my ($av, $ar) = (0, 0); - while ($av < @avsplit and $ar < @arsplit) - { - my ($v, $r) = (ord $avsplit[$av], ord $arsplit[$ar]); - $v += 256 unless chr($v) =~ /[A-Za-z]/; - $r += 256 unless chr($r) =~ /[A-Za-z]/; - return $v <=> $r if $v != $r; - $av++; - $ar++; - } - return 1 if $av < @avsplit; - return -1 if $ar < @arsplit; - } - - return 0 unless length $val and length $ref; - - $val =~ s/^(\d*)//; - my $numval = $1; - $ref =~ s/^(\d*)//; - my $numref = $1; - return $numval <=> $numref if $numval != $numref; - } + + sub order{ + my ($x) = @_; + ##define order(x) ((x) == '~' ? -1 \ + # : cisdigit((x)) ? 0 \ + # : !(x) ? 0 \ + # : cisalpha((x)) ? (x) \ + # : (x) + 256) + # This comparison is out of dpkg's order to avoid + # comparing things to undef and triggering warnings. + if (not defined $x) { + return 0; + } + elsif ($x eq '~') { + return -1; + } + elsif ($x =~ /^\d$/) { + return 0; + } + elsif ($x =~ /^[A-Z]$/i) { + return ord($x); + } + else { + return ord($x) + 256; + } + } + + sub next_elem(\@){ + my $a = shift; + return @{$a} ? shift @{$a} : undef; + } + my ($val, $ref) = @_; + $val = "" if not defined $val; + $ref = "" if not defined $ref; + my @val = split //,$val; + my @ref = split //,$ref; + my $vc = next_elem @val; + my $rc = next_elem @ref; + while (defined $vc or defined $rc) { + my $first_diff = 0; + while ((defined $vc and $vc !~ /^\d$/) or + (defined $rc and $rc !~ /^\d$/)) { + my $vo = order($vc); my $ro = order($rc); + # Unlike dpkg's verrevcmp, we only return 1 or -1 here. + return (($vo - $ro > 0) ? 1 : -1) if $vo != $ro; + $vc = next_elem @val; $rc = next_elem @ref; + } + while (defined $vc and $vc eq '0') { + $vc = next_elem @val; + } + while (defined $rc and $rc eq '0') { + $rc = next_elem @ref; + } + while (defined $vc and $vc =~ /^\d$/ and + defined $rc and $rc =~ /^\d$/) { + $first_diff = ord($vc) - ord($rc) if !$first_diff; + $vc = next_elem @val; $rc = next_elem @ref; + } + return 1 if defined $vc and $vc =~ /^\d$/; + return -1 if defined $rc and $rc =~ /^\d$/; + return $first_diff if $first_diff; + } + return 0; } =item vercmp @@ -98,21 +134,17 @@ sub vercmp ($$) my %refversion = parseversion $_[1]; return 1 if $version{epoch} > $refversion{epoch}; return -1 if $version{epoch} < $refversion{epoch}; - my $r = verrevcmp $version{version}, $refversion{version}; + my $r = verrevcmp($version{version}, $refversion{version}); return $r if $r; - return verrevcmp $version{revision}, $refversion{revision}; + return verrevcmp($version{revision}, $refversion{revision}); } =back -=head1 BUGS - -Version numbers containing the C<~> character, used for pre-releases of -packages, are not yet supported. - =head1 AUTHOR -Colin Watson Ecjwatson@debian.orgE, based on the implementation in +Don Armstrong and Colin Watson +Ecjwatson@debian.orgE, based on the implementation in C by Ian Jackson and others. =cut diff --git a/t/02_version_dpkg.t b/t/02_version_dpkg.t new file mode 100644 index 0000000..9e8e0b0 --- /dev/null +++ b/t/02_version_dpkg.t @@ -0,0 +1,51 @@ +# -*- mode: cperl;-*- + +use Test::More; + +use warnings; +use strict; + +use utf8; +use Encode; + +# 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', + }, + ); + +plan tests => @versions * 2 + 1; + +sub dpkg_vercmp{ + my ($a,$b,$cmp) = @_; + $cmp = 'gt' if not defined $cmp; + return system('dpkg','--compare-versions',$a,$cmp,$b) == 0; +} + + +use_ok('Debbugs::Versions::Dpkg'); + +for my $version_cmp (@versions) { + ok(Debbugs::Versions::Dpkg::vercmp($$version_cmp{a},$$version_cmp{b}) == $$version_cmp{result}, + "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}"); +} + -- 2.39.2