Merge commit '1.15.5.2'

debian/changelog

@@ -11,6 +11,17 @@ dpkg (1.15.6) UNRELEASED; urgency=low
 
  -- Raphaël Hertzog <hertzog@debian.org>  Tue, 17 Nov 2009 17:24:47 +0100
 
+dpkg (1.15.5.2) unstable; urgency=low
+
+  * Change Dpkg::Version API to accept invalid versions by default and add
+    is_valid() method. The boolean evaluation of a version object returns
+    true if the version is valid, false otherwise.
+  * Update dpkg-shlibdeps to always use Dpkg::Version now that it can
+    contain the empty version string. Closes: #556786
+  * Keep compatibility with perl 5.8 by avoiding the _ prototype.
+
+ -- Raphael Hertzog <hertzog@debian.org>  Wed, 18 Nov 2009 11:54:50 +0100
+
 dpkg (1.15.5.1) unstable; urgency=low
 
   * Fix build failures due to off_t type missmatch caused by not including

scripts/Dpkg/Changelog/Entry/Debian.pm

@@ -176,7 +176,7 @@ sub get_source {
 sub get_version {
     my ($self) = @_;
     if (defined($self->{header}) and $self->{header} =~ $regex_header) {
-	return Dpkg::Version->new($2) || $2;
+	return Dpkg::Version->new($2);
     }
     return undef;
 }

scripts/Dpkg/Control/Fields.pm

@@ -412,8 +412,9 @@ added to $to otherwise.
 
 =cut
 
-sub field_transfer_single($$_) {
+sub field_transfer_single($$;$) {
     my ($from, $to, $field) = @_;
+    $field = $_ unless defined $field;
     my ($from_type, $to_type) = ($from->get_type(), $to->get_type());
     $field = field_capitalize($field);
 

scripts/Dpkg/Deps.pm

@@ -517,7 +517,7 @@ sub parse {
     $self->{package} = $1;
     $self->{relation} = version_normalize_relation($2) if defined($2);
     if (defined($3)) {
-        $self->{version} = Dpkg::Version->new($3) || $3;
+        $self->{version} = Dpkg::Version->new($3);
     }
     if (defined($4)) {
 	$self->{arches} = [ split(/\s+/, $4) ];

scripts/Dpkg/Version.pm

@@ -42,7 +42,8 @@ use overload
     '<=>' => \&comparison,
     'cmp' => \&comparison,
     '""'  => \&as_string,
-    'bool' => sub { return 1 };
+    'bool' => sub { return $_[0]->is_valid(); },
+    'fallback' => 1;
 
 =head1 NAME
 
@@ -60,19 +61,27 @@ them.
 
 =over 4
 
-=item my $v = Dpkg::Version->new($version)
+=item my $v = Dpkg::Version->new($version, %opts)
 
 Create a new Dpkg::Version object corresponding to the version indicated in
-the string (scalar) $version. Returns undef if the string doesn't contain
-a valid version (see version_check for details).
+the string (scalar) $version. By default it will accepts any string
+and consider it as a valid version. If you pass the option "check => 1",
+it will return undef if the version is invalid (see version_check for
+details).
+
+You can always call $v->is_valid() later on to verify that the version is
+valid.
 
 =cut
 
 sub new {
-    my ($this, $ver) = @_;
+    my ($this, $ver, %opts) = @_;
     my $class = ref($this) || $this;
     $ver = "$ver" if ref($ver); # Try to stringify objects
-    return undef unless version_check($ver);
+
+    if ($opts{'check'}) {
+	return undef unless version_check($ver);
+    }
 
     my $self = {};
     if ($ver =~ /^(\d*):(.+)$/) {
@@ -94,6 +103,17 @@ sub new {
     return bless $self, $class;
 }
 
+=item $v->is_valid()
+
+Returns true if the version is valid, false otherwise.
+
+=cut
+
+sub is_valid {
+    my ($self) = @_;
+    return scalar version_check($self);
+}
+
 =item $v->epoch(), $v->version(), $v->revision()
 
 Returns the corresponding part of the full version string.
@@ -170,8 +190,8 @@ If $a or $b are not valid version numbers, it dies with an error.
 
 sub version_compare($$) {
     my ($a, $b) = @_;
-    my $va = Dpkg::Version->new($a) || error(_g("%s is not a valid version"), "$a");
-    my $vb = Dpkg::Version->new($b) || error(_g("%s is not a valid version"), "$b");
+    my $va = Dpkg::Version->new($a, check => 1) || error(_g("%s is not a valid version"), "$a");
+    my $vb = Dpkg::Version->new($b, check => 1) || error(_g("%s is not a valid version"), "$b");
     return $va <=> $vb;
 }
 
@@ -250,7 +270,7 @@ of the character is used to sort between characters.
 =cut
 
 sub version_compare_string($$) {
-    sub order(_) {
+    sub order {
         my ($x) = @_;
 	if ($x eq '~') {
 	    return -1;
@@ -262,8 +282,8 @@ sub version_compare_string($$) {
 	    return ord($x) + 256;
 	}
     }
-    my @a = map(order, split(//, shift));
-    my @b = map(order, split(//, shift));
+    my @a = map(order($_), split(//, shift));
+    my @b = map(order($_), split(//, shift));
     while (1) {
         my ($a, $b) = (shift @a, shift @b);
         return 0 if not defined($a) and not defined($b);

scripts/dpkg-shlibdeps.pl

@@ -242,7 +242,7 @@ foreach my $file (keys %exec) {
 		my $minver = $symfile->get_smallest_version($soname) || '';
 		foreach my $subdep (split /\s*,\s*/, $dep) {
 		    if (not exists $dependencies{$cur_field}{$subdep}) {
-			$dependencies{$cur_field}{$subdep} = $minver;
+			$dependencies{$cur_field}{$subdep} = Dpkg::Version->new($minver);
                         print " Initialize dependency ($subdep) with minimal " .
                               "version ($minver)\n" if $debug > 1;
 		    }
@@ -590,6 +590,7 @@ sub get_min_version_from_deps {
 sub update_dependency_version {
     my ($dep, $minver, $existing_only) = @_;
     return if not defined($minver);
+    $minver = Dpkg::Version->new($minver);
     foreach my $subdep (split /\s*,\s*/, $dep) {
 	if (exists $dependencies{$cur_field}{$subdep} and
 	    defined($dependencies{$cur_field}{$subdep}))
@@ -630,8 +631,8 @@ sub add_shlibs_dep {
 	    print " Found $dep in $file\n" if $debug;
 	    foreach (split(/,\s*/, $dep)) {
 		# Note: the value is empty for shlibs based dependency
-		# symbol based dependency will put a version as value
-		$dependencies{$cur_field}{$_} = '';
+		# symbol based dependency will put a valid version as value
+		$dependencies{$cur_field}{$_} = Dpkg::Version->new('');
 	    }
 	    return 1;
 	}

scripts/t/100_Dpkg_Version.t

@@ -28,7 +28,7 @@ my @ops = ("<", "<<", "lt",
 	   ">=", "ge",
 	   ">", ">>", "gt");
 
-plan tests => scalar(@tests) * (3 * scalar(@ops) + 4) + 1;
+plan tests => scalar(@tests) * (3 * scalar(@ops) + 4) + 8;
 
 sub dpkg_vercmp {
      my ($a, $cmp, $b) = @_;
@@ -75,10 +75,23 @@ my $truth = {
     },
 };
 
+# Handling of empty/invalid versions
+my $empty = Dpkg::Version->new("");
+ok($empty eq "", "Dpkg::Version->new('') eq ''");
+ok($empty->as_string() eq "", "Dpkg::Version->new('')->as_string() eq ''");
+ok(!$empty->is_valid(), "empty version is invalid");
+my $ver = Dpkg::Version->new("10a:5.2");
+ok(!$ver->is_valid(), "bad epoch is invalid");
+ok($ver eq '10a:5.2', "invalid still same string 1/2");
+$ver = Dpkg::Version->new('5.2@3-2');
+ok($ver eq '5.2@3-2', "invalid still same string 2/2");
+ok(!$ver->is_valid(), "illegal character is invalid");
+
+# Comparisons
 foreach my $case (@tests) {
     my ($a, $b, $res) = split " ", $case;
-    my $va = Dpkg::Version->new($a);
-    my $vb = Dpkg::Version->new($b);
+    my $va = Dpkg::Version->new($a, check => 1);
+    my $vb = Dpkg::Version->new($b, check => 1);
 
     is("$va", $a, "String representation of Dpkg::Version($a) is $a");
     is("$vb", $b, "String representation of Dpkg::Version($b) is $b");