From: Guillem Jover Date: Sun, 13 May 2007 05:15:02 +0000 (+0000) Subject: Fix perl warnings: X-Git-Url: https://err.no/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=26baf391c4c5e6db55fd5f42ead13a1aeebf067f;p=dpkg Fix perl warnings: - In architecture comparison operations. Closes: #423452 --- diff --git a/ChangeLog b/ChangeLog index b614d2c8..3dccd77e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,4 +1,15 @@ -2007-05-11 Guillem Jover +2007-05-13 Guillem Jover + + * scripts/controllib.pl (debarch_eq): Return 0 if + debarch_to_debtriplet returns any undef value. + (debarch_is): Likewise. As a side effect of changing to use arrays for + the real and alias architectures, all parts of the triplet are now + compared against 'any' as well. + * scripts/dpkg-genchanges.pl: Remove redundant debarch_is being + handled already in the grep. + * scripts/dpkg-gencontrol.pl: Likewise. + +2007-05-12 Guillem Jover * scripts/controllib.pl (debian_arch_eq): Rename to ... (debarch_eq): ... this. Add prototype. Fix all callers. diff --git a/debian/changelog b/debian/changelog index c5ce4657..90045d1d 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,7 +1,9 @@ dpkg (1.14.3) UNRELEASED; urgency=low [ Guillem Jover ] - * Fix perl warnings in dpkg-genchanges when called with -S. Closes: #423193 + * Fix perl warnings: + - In dpkg-genchanges when called with -S. Closes: #423193 + - In architecture comparison operations. Closes: #423452 * Include the new split man pages deb-substvars.5, deb-override.5 and deb-shlibs.5 in dpkg-dev. * Fix deb-substvars.5 section to match reality. diff --git a/scripts/controllib.pl b/scripts/controllib.pl index 66c54228..e3c7ad00 100755 --- a/scripts/controllib.pl +++ b/scripts/controllib.pl @@ -274,25 +274,25 @@ sub debarch_to_debtriplet($) sub debarch_eq($$) { my ($a, $b) = @_; - my ($a_abi, $a_os, $a_cpu) = debarch_to_debtriplet($a); - my ($b_abi, $b_os, $b_cpu) = debarch_to_debtriplet($b); + my @a = debarch_to_debtriplet($a); + my @b = debarch_to_debtriplet($b); - return ("$a_abi-$a_os-$a_cpu" eq "$b_abi-$b_os-$b_cpu"); + return 0 if grep(!defined, (@a, @b)); + + return ($a[0] eq $b[0] && $a[1] eq $b[1] && $a[2] eq $b[2]); } sub debarch_is($$) { my ($real, $alias) = @_; - my ($real_abi, $real_os, $real_cpu) = debarch_to_debtriplet($real); - my ($alias_abi, $alias_os, $alias_cpu) = debarch_to_debtriplet($alias); + my @real = debarch_to_debtriplet($real); + my @alias = debarch_to_debtriplet($alias); - if ("$real_abi-$real_os-$real_cpu" eq "$alias_abi-$alias_os-$alias_cpu") { - return 1; - } elsif ("$alias_abi-$alias_os-$alias_cpu" eq "any-any-any") { - return 1; - } elsif ("$alias_abi-$alias_os-$alias_cpu" eq "$real_abi-any-$real_cpu") { - return 1; - } elsif ("$alias_abi-$alias_os-$alias_cpu" eq "$real_abi-$real_os-any") { + return 0 if grep(!defined, (@real, @alias)); + + if (($alias[0] eq $real[0] || $alias[0] eq 'any') && + ($alias[1] eq $real[1] || $alias[1] eq 'any') && + ($alias[2] eq $real[2] || $alias[2] eq 'any')) { return 1; } diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl index ddf230cc..54abf1bb 100755 --- a/scripts/dpkg-genchanges.pl +++ b/scripts/dpkg-genchanges.pl @@ -222,7 +222,6 @@ for $_ (keys %fi) { if (!defined($p2f{$p}) && not $sourceonly) { if ((debarch_eq('all', $a) && !$archspecific) || - debarch_is($host_arch, $a) || grep(debarch_is($host_arch, $_), split(/\s+/, $a))) { warning(sprintf(_g("package %s in control file but not in files list"), $p)); next; @@ -246,8 +245,7 @@ for $_ (keys %fi) { $f{$_}= $v; } elsif (m/^Architecture$/) { if (not $sourceonly) { - if (debarch_is($host_arch, $v) || - grep(debarch_is($host_arch, $_), split(/\s+/, $v))) { + if (grep(debarch_is($host_arch, $_), split(/\s+/, $v))) { $v = $host_arch; } elsif (!debarch_eq('all', $v)) { $v= ''; diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl index 332d6553..56ac9af5 100755 --- a/scripts/dpkg-gencontrol.pl +++ b/scripts/dpkg-gencontrol.pl @@ -171,8 +171,6 @@ for $_ (keys %fi) { if (debarch_eq('all', $v)) { $f{$_}= $v; - } elsif (debarch_is($host_arch, $v)) { - $f{$_} = $host_arch; } else { my @archlist = split(/\s+/, $v); my @invalid_archs = grep m/[^\w-]/, @archlist;