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.
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.
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/>.
21 use Dpkg::ErrorHandling;
24 report_options(quiet_warnings => 1);
27 my @ops = ('<', '<<', 'lt',
33 plan tests => scalar(@tests) * (3 * scalar(@ops) + 4) + 30;
36 my ($a, $cmp, $b) = @_;
39 spawn(exec => [ 'dpkg', '--compare-versions', '--', $a, $cmp, $b ],
40 error_to_string => \$stderr, wait_child => 1, nocheck => 1);
41 diag("dpkg --compare-versions error=$?: $stderr") if $? and $? != 256;
47 my ($a, $cmp, $b) = @_;
48 return $a < $b if $cmp eq '<<';
49 return $a lt $b if $cmp eq 'lt';
50 return $a <= $b if $cmp eq '<=' or $cmp eq '<';
51 return $a le $b if $cmp eq 'le';
52 return $a == $b if $cmp eq '=';
53 return $a eq $b if $cmp eq 'eq';
54 return $a >= $b if $cmp eq '>=' or $cmp eq '>';
55 return $a ge $b if $cmp eq 'ge';
56 return $a > $b if $cmp eq '>>';
57 return $a gt $b if $cmp eq 'gt';
60 use_ok('Dpkg::Version');
65 '<=' => 1, 'le' => 1, '<' => 1,
67 '>=' => 0, 'ge' => 0, '>' => 0,
72 '<=' => 1, 'le' => 1, '<' => 1,
74 '>=' => 1, 'ge' => 1, '>' => 1,
79 '<=' => 0, 'le' => 0, '<' => 0,
81 '>=' => 1, 'ge' => 1, '>' => 1,
86 # Handling of empty/invalid versions
87 my $empty = Dpkg::Version->new('');
88 ok($empty eq '', "Dpkg::Version->new('') eq ''");
89 ok($empty->as_string() eq '', "Dpkg::Version->new('')->as_string() eq ''");
90 ok(!$empty->is_valid(), 'empty version is invalid');
91 $empty = Dpkg::Version->new('-0');
92 ok($empty eq '', "Dpkg::Version->new('-0') eq '-0'");
93 ok($empty->as_string() eq '-0', "Dpkg::Version->new('-0')->as_string() eq '-0'");
94 ok(!$empty->is_valid(), 'empty upstream version is invalid');
95 $empty = Dpkg::Version->new('0:-0');
96 ok($empty eq '0:-0', "Dpkg::Version->new('0:-0') eq '0:-0'");
97 ok($empty->as_string() eq '0:-0', "Dpkg::Version->new('0:-0')->as_string() eq '0:-0'");
98 ok(!$empty->is_valid(), 'empty upstream version with epoch is invalid');
99 $empty = Dpkg::Version->new(':1.0');
100 ok($empty eq ':1.0', "Dpkg::Version->new(':1.0') eq ':1.0'");
101 ok($empty->as_string() eq ':1.0', "Dpkg::Version->new(':1.0')->as_string() eq ':1.0'");
102 ok(!$empty->is_valid(), 'empty epoch is invalid');
103 $empty = Dpkg::Version->new('1.0-');
104 ok($empty eq '1.0-', "Dpkg::Version->new('1.0-') eq '1.0-'");
105 ok($empty->as_string() eq '1.0-', "Dpkg::Version->new('1.0-')->as_string() eq '1.0-'");
106 ok(!$empty->is_valid(), 'empty revision is invalid');
107 my $ver = Dpkg::Version->new('10a:5.2');
108 ok(!$ver->is_valid(), 'bad epoch is invalid');
109 ok(!$ver, 'bool eval of invalid leads to false');
110 ok($ver eq '10a:5.2', 'invalid still same string 1/2');
111 $ver = Dpkg::Version->new('5.2@3-2');
112 ok($ver eq '5.2@3-2', 'invalid still same string 2/2');
113 ok(!$ver->is_valid(), 'illegal character is invalid');
114 $ver = Dpkg::Version->new('foo5.2');
115 ok(!$ver->is_valid(), 'version does not start with digit 1/2');
116 $ver = Dpkg::Version->new('0:foo5.2');
117 ok(!$ver->is_valid(), 'version does not start with digit 2/2');
119 # Native and non-native versions
120 $ver = Dpkg::Version->new('1.0');
121 ok($ver->is_native(), 'upstream version is native');
122 $ver = Dpkg::Version->new('1:1.0');
123 ok($ver->is_native(), 'upstream version w/ epoch is native');
124 $ver = Dpkg::Version->new('1:1.0:1.0');
125 ok($ver->is_native(), 'upstream version w/ epoch and colon is native');
126 $ver = Dpkg::Version->new('1.0-1');
127 ok(!$ver->is_native(), 'upstream version w/ revision is not native');
128 $ver = Dpkg::Version->new('1.0-1.0-1');
129 ok(!$ver->is_native(), 'upstream version w/ dash and revision is not native');
132 $ver = Dpkg::Version->new('1.2.3-4');
133 is($ver || 'default', '1.2.3-4', 'bool eval returns string representation');
134 $ver = Dpkg::Version->new('0');
135 is($ver || 'default', 'default', 'bool eval of version 0 is still false...');
138 foreach my $case (@tests) {
139 my ($a, $b, $res) = split ' ', $case;
140 my $va = Dpkg::Version->new($a, check => 1);
141 my $vb = Dpkg::Version->new($b, check => 1);
143 is("$va", $a, "String representation of Dpkg::Version($a) is $a");
144 is("$vb", $b, "String representation of Dpkg::Version($b) is $b");
146 is(version_compare($a, $b), $res, "$a cmp $b => $res");
147 is($va <=> $vb, $res, "Dpkg::Version($a) <=> Dpkg::Version($b) => $res");
148 foreach my $op (@ops) {
149 my $norm_op = version_normalize_relation($op);
150 if ($truth->{$res}{$op}) {
151 ok(version_compare_relation($a, $norm_op, $b), "$a $op $b => true");
152 ok(obj_vercmp($va, $op, $vb), "Dpkg::Version($a) $op Dpkg::Version($b) => true");
153 ok(dpkg_vercmp($a, $op, $b), "dpkg --compare-versions -- $a $op $b => true");
155 ok(!version_compare_relation($a, $norm_op, $b), "$a $op $b => false");
156 ok(!obj_vercmp($va, $op, $vb), "Dpkg::Version($a) $op Dpkg::Version($b) => false");
157 ok(!dpkg_vercmp($a, $op, $b), "dpkg --compare-versions -- $a $op $b => false");
178 0foo~foo+Bar 0foo~foo+bar -1
181 12345+that-really-is-some-ver-0 12345+that-really-is-some-ver-10 -1
186 0foo1bar-1 0foobar-1 -1
188 0foo2.0.0 0foo2.10.0 -1
195 0.9j-20080306-4 0.9i-20070324-2 1
196 1.2.0~b7-1 1.2.0~b6-1 1
198 0.0.9+dfsg1-1 0.0.8+dfsg1-3 1
199 4.6.99+svn6582-1 4.6.99+svn6496-1 1
201 0.9.9~pre122-1 0.9.9~pre111-1 1
202 2:2.3.2-2+lenny2 2:2.3.2-2 1
204 1.0.1+gpl-1 1.0.1-2 1