t/30-atom-new.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 25;
   7
   8 use CPANPLUS::Dist::Gentoo::Atom;
   9
  10 sub A () { 'CPANPLUS::Dist::Gentoo::Atom' }
  11
  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/;
  16
  17 sub inv { qr/^Invalid \Q$_[0]\E/ }
  18
  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' };
  22
  23 my $v0 = bless { }, 'CPANPLUS::Dist::Gentoo::Test::FakeVersion';
  24 my $v1 = CPANPLUS::Dist::Gentoo::Version->new('0.1.2-r3');
  25
  26 my @tests = (
  27  [ { }                     => $no_info ],
  28  [ { category => 'test' }  => $no_info ],
  29  [ { name => 'a'  }        => $no_category ],
  30
  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')     ],
  35
  36  [ $a0                     => $a0 ],
  37  [ { %$a0, range => ''   } => { %$a0, range => '' } ],
  38  [ { %$a0, range => '<=' } => $range_no_ver ],
  39
  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 => '<=' } ],
  45
  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 ],
  51
  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 => '>=' } ],
  57 );
  58
  59 my @fields = qw<range category name version ebuild>;
  60
  61 for my $t (@tests) {
  62  my ($args, $exp) = @$t;
  63
  64  my ($meth, @args);
  65  if (exists $args->{ebuild}) {
  66   $meth = 'new_from_ebuild';
  67   @args = ($args->{ebuild});
  68  } else {
  69   $meth = 'new';
  70   @args = %$args;
  71  }
  72
  73  my $atom = eval { A->$meth(@args) };
  74  my $err  = $@;
  75
  76  if (ref $exp eq 'Regexp') {
  77   like $err, $exp;
  78  } elsif ($err) {
  79   fail $err;
  80  } else {
  81   $exp = { %$exp };
  82   for (@fields) {
  83    next if exists $exp->{$_};
  84    $exp->{$_} = ($_ eq 'ebuild' and exists $args->{ebuild})
  85                 ? $args->{ebuild}
  86                 : undef;
  87   }
  88   is_deeply {
  89    map { my $val = $atom->$_; $_ => (defined $val ? "$val" : undef) } @fields
  90   }, $exp;
  91  }
  92 }