1#!/usr/bin/perl 2# 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License 14# along with this program. If not, see <https://www.gnu.org/licenses/>. 15 16use strict; 17use warnings; 18 19use Test::More; 20 21use Dpkg::ErrorHandling; 22use Dpkg::IPC; 23use Dpkg::Path qw(find_command); 24use Dpkg::Version; 25 26report_options(quiet_warnings => 1); 27 28my @tests = <DATA>; 29my @ops = ('<', '<<', 'lt', 30 '<=', 'le', 31 '=', 'eq', 32 '>=', 'ge', 33 '>', '>>', 'gt'); 34 35plan tests => scalar(@tests) * (3 * scalar(@ops) + 4) + 27; 36 37my $have_dpkg = find_command('dpkg'); 38 39sub dpkg_vercmp { 40 my ($a, $cmp, $b) = @_; 41 my $stderr; 42 43 spawn(exec => [ 'dpkg', '--compare-versions', '--', $a, $cmp, $b ], 44 error_to_string => \$stderr, wait_child => 1, nocheck => 1); 45 diag("dpkg --compare-versions error=$?: $stderr") if $? and $? != 256; 46 47 return $? == 0; 48} 49 50sub obj_vercmp { 51 my ($a, $cmp, $b) = @_; 52 return $a < $b if $cmp eq '<<'; 53 return $a lt $b if $cmp eq 'lt'; 54 return $a <= $b if $cmp eq '<=' or $cmp eq '<'; 55 return $a le $b if $cmp eq 'le'; 56 return $a == $b if $cmp eq '='; 57 return $a eq $b if $cmp eq 'eq'; 58 return $a >= $b if $cmp eq '>=' or $cmp eq '>'; 59 return $a ge $b if $cmp eq 'ge'; 60 return $a > $b if $cmp eq '>>'; 61 return $a gt $b if $cmp eq 'gt'; 62} 63 64my $truth = { 65 '-1' => { 66 '<<' => 1, 'lt' => 1, 67 '<=' => 1, 'le' => 1, '<' => 1, 68 '=' => 0, 'eq' => 0, 69 '>=' => 0, 'ge' => 0, '>' => 0, 70 '>>' => 0, 'gt' => 0, 71 }, 72 '0' => { 73 '<<' => 0, 'lt' => 0, 74 '<=' => 1, 'le' => 1, '<' => 1, 75 '=' => 1, 'eq' => 1, 76 '>=' => 1, 'ge' => 1, '>' => 1, 77 '>>' => 0, 'gt' => 0, 78 }, 79 '1' => { 80 '<<' => 0, 'lt' => 0, 81 '<=' => 0, 'le' => 0, '<' => 0, 82 '=' => 0, 'eq' => 0, 83 '>=' => 1, 'ge' => 1, '>' => 1, 84 '>>' => 1, 'gt' => 1, 85 }, 86}; 87 88# XXX: Some of the tests check the bool overload, which currently emits 89# the semantic_change warning. Disable it until we stop emitting the 90# warning in dpkg 1.20.x. 91## no critic (TestingAndDebugging::ProhibitNoWarnings) 92no warnings(qw(Dpkg::Version::semantic_change::overload::bool)); 93 94# Handling of empty/invalid versions 95my $empty = Dpkg::Version->new(''); 96ok($empty eq '', "Dpkg::Version->new('') eq ''"); 97ok($empty->as_string() eq '', "Dpkg::Version->new('')->as_string() eq ''"); 98ok(!$empty->is_valid(), 'empty version is invalid'); 99$empty = Dpkg::Version->new('-0'); 100ok($empty eq '', "Dpkg::Version->new('-0') eq '-0'"); 101ok($empty->as_string() eq '-0', "Dpkg::Version->new('-0')->as_string() eq '-0'"); 102ok(!$empty->is_valid(), 'empty upstream version is invalid'); 103$empty = Dpkg::Version->new('0:-0'); 104ok($empty eq '0:-0', "Dpkg::Version->new('0:-0') eq '0:-0'"); 105ok($empty->as_string() eq '0:-0', "Dpkg::Version->new('0:-0')->as_string() eq '0:-0'"); 106ok(!$empty->is_valid(), 'empty upstream version with epoch is invalid'); 107$empty = Dpkg::Version->new(':1.0'); 108ok($empty eq ':1.0', "Dpkg::Version->new(':1.0') eq ':1.0'"); 109ok($empty->as_string() eq ':1.0', "Dpkg::Version->new(':1.0')->as_string() eq ':1.0'"); 110ok(!$empty->is_valid(), 'empty epoch is invalid'); 111$empty = Dpkg::Version->new('1.0-'); 112ok($empty eq '1.0-', "Dpkg::Version->new('1.0-') eq '1.0-'"); 113ok($empty->as_string() eq '1.0-', "Dpkg::Version->new('1.0-')->as_string() eq '1.0-'"); 114ok(!$empty->is_valid(), 'empty revision is invalid'); 115my $ver = Dpkg::Version->new('10a:5.2'); 116ok(!$ver->is_valid(), 'bad epoch is invalid'); 117ok(!$ver, 'bool eval of invalid leads to false'); 118ok($ver eq '10a:5.2', 'invalid still same string 1/2'); 119$ver = Dpkg::Version->new('5.2@3-2'); 120ok($ver eq '5.2@3-2', 'invalid still same string 2/2'); 121ok(!$ver->is_valid(), 'illegal character is invalid'); 122$ver = Dpkg::Version->new('foo5.2'); 123ok(!$ver->is_valid(), 'version does not start with digit 1/2'); 124$ver = Dpkg::Version->new('0:foo5.2'); 125ok(!$ver->is_valid(), 'version does not start with digit 2/2'); 126 127# Native and non-native versions 128$ver = Dpkg::Version->new('1.0'); 129ok($ver->is_native(), 'upstream version is native'); 130$ver = Dpkg::Version->new('1:1.0'); 131ok($ver->is_native(), 'upstream version w/ epoch is native'); 132$ver = Dpkg::Version->new('1:1.0:1.0'); 133ok($ver->is_native(), 'upstream version w/ epoch and colon is native'); 134$ver = Dpkg::Version->new('1.0-1'); 135ok(!$ver->is_native(), 'upstream version w/ revision is not native'); 136$ver = Dpkg::Version->new('1.0-1.0-1'); 137ok(!$ver->is_native(), 'upstream version w/ dash and revision is not native'); 138 139# Comparisons 140foreach my $case (@tests) { 141 my ($a, $b, $res) = split ' ', $case; 142 my $va = Dpkg::Version->new($a, check => 1); 143 my $vb = Dpkg::Version->new($b, check => 1); 144 145 is("$va", $a, "String representation of Dpkg::Version($a) is $a"); 146 is("$vb", $b, "String representation of Dpkg::Version($b) is $b"); 147 148 is(version_compare($a, $b), $res, "$a cmp $b => $res"); 149 is($va <=> $vb, $res, "Dpkg::Version($a) <=> Dpkg::Version($b) => $res"); 150 foreach my $op (@ops) { 151 my $norm_op = version_normalize_relation($op); 152 if ($truth->{$res}{$op}) { 153 ok(version_compare_relation($a, $norm_op, $b), "$a $op $b => true"); 154 ok(obj_vercmp($va, $op, $vb), "Dpkg::Version($a) $op Dpkg::Version($b) => true"); 155 156 SKIP: { 157 skip 'dpkg not available', 1 if not $have_dpkg; 158 159 ok(dpkg_vercmp($a, $op, $b), "dpkg --compare-versions -- $a $op $b => true"); 160 } 161 } else { 162 ok(!version_compare_relation($a, $norm_op, $b), "$a $op $b => false"); 163 ok(!obj_vercmp($va, $op, $vb), "Dpkg::Version($a) $op Dpkg::Version($b) => false"); 164 165 SKIP: { 166 skip 'dpkg not available', 1 if not $have_dpkg; 167 168 ok(!dpkg_vercmp($a, $op, $b), "dpkg --compare-versions -- $a $op $b => false"); 169 } 170 } 171 } 172} 173 174__DATA__ 1751.0-1 2.0-2 -1 1762.2~rc-4 2.2-1 -1 1772.2-1 2.2~rc-4 1 1781.0000-1 1.0-1 0 1791 0:1 0 1800 0:0-0 0 1812:2.5 1:7.5 1 1821:0foo 0foo 1 1830:0foo 0foo 0 1840foo 0foo 0 1850foo-0 0foo 0 1860foo 0foo-0 0 1870foo 0fo 1 1880foo-0 0foo+ -1 1890foo~1 0foo -1 1900foo~foo+Bar 0foo~foo+bar -1 1910foo~~ 0foo~ -1 1921~ 1 -1 19312345+that-really-is-some-ver-0 12345+that-really-is-some-ver-10 -1 1940foo-0 0foo-01 -1 1950foo.bar 0foobar 1 1960foo.bar 0foo1bar 1 1970foo.bar 0foo0bar 1 1980foo1bar-1 0foobar-1 -1 1990foo2.0 0foo2 1 2000foo2.0.0 0foo2.10.0 -1 2010foo2.0 0foo2.0.0 -1 2020foo2.0 0foo2.10 -1 2030foo2.1 0foo2.10 -1 2041.09 1.9 0 2051.0.8+nmu1 1.0.8 1 2063.11 3.10+nmu1 1 2070.9j-20080306-4 0.9i-20070324-2 1 2081.2.0~b7-1 1.2.0~b6-1 1 2091.011-1 1.06-2 1 2100.0.9+dfsg1-1 0.0.8+dfsg1-3 1 2114.6.99+svn6582-1 4.6.99+svn6496-1 1 21253 52 1 2130.9.9~pre122-1 0.9.9~pre111-1 1 2142:2.3.2-2+lenny2 2:2.3.2-2 1 2151:3.8.1-1 3.8.GA-1 1 2161.0.1+gpl-1 1.0.1-2 1 2171a 1000a -1 218