6 use Test::More tests => 25;
8 use CPANPLUS::Dist::Gentoo::Atom;
10 sub A () { 'CPANPLUS::Dist::Gentoo::Atom' }
12 my $no_info = qr/^Not enough information/;
13 my $no_category = qr/^Category unspecified/;
14 my $range_no_ver = qr/^Range atoms require a valid version/;
15 my $cant_parse_ver = qr/^Couldn't parse version string/;
17 sub inv { qr/^Invalid \Q$_[0]\E/ }
19 my $a0 = { category => 'test', name => 'a' };
20 my $a1 = { category => 'test', name => 'a', version => '1.0' };
21 my $a2 = { category => 'test+', name => 'a+b', version => '1.2.3' };
23 my $v0 = bless { }, 'CPANPLUS::Dist::Gentoo::Test::FakeVersion';
24 my $v1 = CPANPLUS::Dist::Gentoo::Version->new('0.1.2-r3');
28 [ { category => 'test' } => $no_info ],
29 [ { name => 'a' } => $no_category ],
31 [ { category => '', name => 'a' } => inv('category') ],
32 [ { category => 'test$', name => 'a' } => inv('category') ],
33 [ { category => 'test', name => '' } => inv('name') ],
34 [ { category => 'test', name => 'a$' } => inv('name') ],
37 [ { %$a0, range => '' } => { %$a0, range => '' } ],
38 [ { %$a0, range => '<=' } => $range_no_ver ],
40 [ $a1 => { %$a1, range => '>=' } ],
41 [ { %$a1, version => $v0 } => $cant_parse_ver ],
42 [ { %$a1, version => $v1 } => { %$a1, range => '>=', version => '0.1.2-r3' } ],
43 [ { %$a1, range => '<>' } => inv('range'), ],
44 [ { %$a1, range => '<=' } => { %$a1, range => '<=' } ],
46 [ { atom => 'test/a' } => $a0 ],
47 [ { atom => 'test/a-1.0' } => { %$a1, range => '>=' } ],
48 [ { atom => '=test/a-1.0' } => { %$a1, range => '=' } ],
49 [ { atom => '=<test/a-1.0' } => inv('atom') ],
50 [ { atom => '>=test/a' } => $range_no_ver ],
52 [ { ebuild => undef } => inv('ebuild') ],
53 [ { ebuild => '/wat/test/a/a.ebuild' } => inv('ebuild') ],
54 [ { ebuild => '/wat/test/a/a-1.0.ebuild' } => { %$a1, range => '>=' } ],
55 [ { ebuild => '/wat/test/a/b-1.0.ebuild' } => inv('ebuild') ],
56 [ { ebuild => '/wat/test+/a+b/a+b-1.2.3.ebuild' } => { %$a2, range => '>=' } ],
59 my @fields = qw<range category name version ebuild>;
62 my ($args, $exp) = @$t;
65 if (exists $args->{ebuild}) {
66 $meth = 'new_from_ebuild';
67 @args = ($args->{ebuild});
73 my $atom = eval { A->$meth(@args) };
76 if (ref $exp eq 'Regexp') {
83 next if exists $exp->{$_};
84 $exp->{$_} = ($_ eq 'ebuild' and exists $args->{ebuild})
89 map { my $val = $atom->$_; $_ => (defined $val ? "$val" : undef) } @fields