my $v1 = $a1->version;
my $v2;
- if (Scalar::Util::blessed($a2) and $a2->isa(__PACKAGE__)) {
- Carp::confess('Can\'t compare atoms of different packages')
- if $a1->category ne $a2->category or $a1->name ne $a2->name;
+ my $blessed = Scalar::Util::blessed($a2);
+ unless ($blessed and $a2->isa(__PACKAGE__)) {
+ if ($blessed and $a2->isa('CPANPLUS::Dist::Gentoo::Version')) {
+ $v2 = $a2;
+ $a2 = undef;
+ } else {
+ my $maybe_atom = eval { __PACKAGE__->new(atom => $a2) };
+ if (my $err = $@) {
+ $v2 = eval { CPANPLUS::Dist::Gentoo::Version->new($a2) };
+ Carp::confess("Can't compare an atom against something that's not an atom, an atom string ($err), a version or a version string ($@)") if $@;
+ $a2 = undef;
+ } else {
+ $a2 = $maybe_atom;
+ }
+ }
+ }
+
+ if (defined $a2) {
$v2 = $a2->version;
- } else {
- $v2 = $a2;
+
+ my $p1 = $a1->qualified_name;
+ my $p2 = $a2->qualified_name;
+ Carp::confess("Atoms for different packages $p1 and $p2") unless $p1 eq $p2;
}
($v1, $v2) = ($v2, $v1) if $r;
+ return (defined $v1 or 0) <=> (defined $v2 or 0) unless defined $v1
+ and defined $v2;
+
return $v1 <=> $v2;
}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4 * ((8 * 7) / 2);
+
+use CPANPLUS::Dist::Gentoo::Atom;
+
+sub A () { 'CPANPLUS::Dist::Gentoo::Atom' }
+
+my $a0 = A->new(
+ category => 'test',
+ name => 'a',
+);
+
+my $a1 = A->new(
+ category => 'test',
+ name => 'a',
+ version => '1.0',
+ range => '=',
+);
+
+my $a2 = A->new(
+ category => 'test',
+ name => 'a',
+ version => '1.0',
+ range => '<',
+);
+
+my $a3 = A->new(
+ category => 'test',
+ name => 'a',
+ version => '1.0',
+ range => '<=',
+);
+
+my $a4 = A->new(
+ category => 'test',
+ name => 'a',
+ version => '2.0',
+ range => '=',
+);
+
+my $a5 = A->new(
+ category => 'test',
+ name => 'a',
+ version => '2.0',
+ range => '>=',
+);
+
+my $a6 = A->new(
+ category => 'test',
+ name => 'a',
+ version => '2.0',
+ range => '>',
+);
+
+my @tests = (
+ [ $a0, $a0 => 0 ],
+ [ $a0, $a1 => -1 ],
+ [ $a0, $a2 => -1 ],
+ [ $a0, $a3 => -1 ],
+ [ $a0, $a4 => -1 ],
+ [ $a0, $a5 => -1 ],
+ [ $a0, $a6 => -1 ],
+
+ [ $a1, $a1 => 0 ],
+ [ $a1, $a2 => 0 ],
+ [ $a1, $a3 => 0 ],
+ [ $a1, $a4 => -1 ],
+ [ $a1, $a5 => -1 ],
+ [ $a1, $a6 => -1 ],
+
+ [ $a2, $a2 => 0 ],
+ [ $a2, $a3 => 0 ],
+ [ $a2, $a4 => -1 ],
+ [ $a2, $a5 => -1 ],
+ [ $a2, $a5 => -1 ],
+
+ [ $a3, $a3 => 0 ],
+ [ $a3, $a4 => -1 ],
+ [ $a3, $a5 => -1 ],
+ [ $a3, $a6 => -1 ],
+
+ [ $a4, $a4 => 0 ],
+ [ $a4, $a5 => 0 ],
+ [ $a4, $a6 => 0 ],
+
+ [ $a5, $a5 => 0 ],
+ [ $a5, $a6 => 0 ],
+
+ [ $a6, $a6 => 0 ],
+);
+
+sub compare_ok {
+ my ($a, $cmp, $b, $exp) = @_;
+
+ my $desc = join " $cmp ", map "'$_'", $a, $b;
+
+ my $c = eval "\$a $cmp \$b";
+ my $err = $@;
+
+ if (ref $exp eq 'Regexp') {
+ like $err, $exp, "$desc should fail";
+ } else {
+ is $c, $exp, "$desc == '$exp'";
+ }
+}
+
+for my $t (@tests) {
+ my ($a, $b, $exp) = @$t;
+
+ for my $r (0 .. 1) {
+ if ($r) {
+ ($a, $b) = ($b, $a);
+ $exp = -$exp;
+ }
+
+ compare_ok($a, '<=>', $b, $exp);
+ compare_ok($a, 'cmp', $b, $exp);
+ }
+}