t/30-atom-new.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 15;
   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 $range_no_ver = qr/^Range atoms require a valid version/;
  14 my $inv_atom     = qr/^Invalid atom/;
  15 my $inv_ebuild   = qr/^Invalid ebuild/;
  16
  17 my $a0 = { category => 'test', name => 'a' };
  18 my $a1 = { category => 'test', name => 'a', version => '1.0' };
  19
  20 my @tests = (
  21  [ { }                     => $no_info ],
  22  [ { category => 'test' }  => $no_info ],
  23  [ $a0                     => $a0 ],
  24  [ { %$a0, range => '<=' } => $range_no_ver ],
  25  [ $a1                     => { %$a1, range => '>=' } ],
  26  [ { %$a1, range => '<=' } => { %$a1, range => '<=' } ],
  27
  28  [ { atom => 'test/a' }        => $a0 ],
  29  [ { atom => 'test/a-1.0' }    => { %$a1, range => '>=' } ],
  30  [ { atom => '=test/a-v1.0' }  => { %$a1, range => '=' } ],
  31  [ { atom => '=<test/a-v1.0' } => $inv_atom ],
  32  [ { atom => '>=test/a' }      => $range_no_ver ],
  33
  34  [ { ebuild => undef }                      => $inv_ebuild ],
  35  [ { ebuild => '/wat/test/a/a.ebuild' }     => $inv_ebuild ],
  36  [ { ebuild => '/wat/test/a/a-1.0.ebuild' } => { %$a1, range => '>=' } ],
  37  [ { ebuild => '/wat/test/a/b-1.0.ebuild' } => $inv_ebuild ],
  38 );
  39
  40 my @fields = qw/range category name version ebuild/;
  41
  42 for my $t (@tests) {
  43  my ($args, $exp) = @$t;
  44
  45  my ($meth, @args);
  46  if (exists $args->{ebuild}) {
  47   $meth = 'new_from_ebuild';
  48   @args = ($args->{ebuild});
  49  } else {
  50   $meth = 'new';
  51   @args = %$args;
  52  }
  53
  54  my $atom = eval { A->$meth(@args) };
  55  my $err  = $@;
  56
  57  if (ref $exp eq 'Regexp') {
  58   like $err, $exp;
  59  } elsif ($err) {
  60   fail $err;
  61  } else {
  62   $exp = { %$exp };
  63   for (@fields) {
  64    next if exists $exp->{$_};
  65    $exp->{$_} = ($_ eq 'ebuild' and exists $args->{ebuild})
  66                 ? $args->{ebuild}
  67                 : undef;
  68   }
  69   is_deeply {
  70    map { my $val = $atom->$_; $_ => (defined $val ? "$val" : undef) } @fields
  71   }, $exp;
  72  }
  73 }