t/31-atom-and.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 2 * (2 + (8 * 7) / 2 + 2);
   7
   8 use CPANPLUS::Dist::Gentoo::Atom;
   9
  10 sub A () { 'CPANPLUS::Dist::Gentoo::Atom' }
  11
  12 my $a0 = A->new(
  13  category => 'test',
  14  name     => 'a',
  15 );
  16
  17 my $a1 = A->new(
  18  category => 'test',
  19  name     => 'a',
  20  version  => '1.0',
  21  range    => '=',
  22 );
  23
  24 my $a2 = A->new(
  25  category => 'test',
  26  name     => 'a',
  27  version  => '1.0',
  28  range    => '<',
  29 );
  30
  31 my $a3 = A->new(
  32  category => 'test',
  33  name     => 'a',
  34  version  => '1.0',
  35  range    => '<=',
  36 );
  37
  38 my $a4 = A->new(
  39  category => 'test',
  40  name     => 'a',
  41  version  => '2.0',
  42  range    => '=',
  43 );
  44
  45 my $a5 = A->new(
  46  category => 'test',
  47  name     => 'a',
  48  version  => '2.0',
  49  range    => '>=',
  50 );
  51
  52 my $a6 = A->new(
  53  category => 'test',
  54  name     => 'a',
  55  version  => '2.0',
  56  range    => '>',
  57 );
  58
  59 my $x_ver   = qr/Version mismatch/;
  60 my $x_range = qr/Incompatible ranges/;
  61
  62 my @tests = (
  63  [ [ $a0 ] => $a0 ],
  64  [ [ $a1 ] => $a1 ],
  65
  66  [ [ $a0, $a0 ] => $a0 ],
  67  [ [ $a0, $a1 ] => $a1 ],
  68  [ [ $a0, $a2 ] => $a2 ],
  69  [ [ $a0, $a3 ] => $a3 ],
  70  [ [ $a0, $a4 ] => $a4 ],
  71  [ [ $a0, $a5 ] => $a5 ],
  72  [ [ $a0, $a6 ] => $a6 ],
  73
  74  [ [ $a1, $a1 ] => $a1 ],
  75  [ [ $a1, $a2 ] => $x_ver ],
  76  [ [ $a1, $a3 ] => $a1 ],
  77  [ [ $a1, $a4 ] => $x_ver ],
  78  [ [ $a1, $a5 ] => $x_ver ],
  79  [ [ $a1, $a6 ] => $x_ver ],
  80
  81  [ [ $a2, $a2 ] => $a2 ],
  82  [ [ $a2, $a3 ] => $a2 ],
  83  [ [ $a2, $a4 ] => $x_ver ],
  84  [ [ $a2, $a5 ] => $x_range ],
  85  [ [ $a2, $a5 ] => $x_range ],
  86
  87  [ [ $a3, $a3 ] => $a3 ],
  88  [ [ $a3, $a4 ] => $a4 ],
  89  [ [ $a3, $a5 ] => $x_range ],
  90  [ [ $a3, $a6 ] => $x_range ],
  91
  92  [ [ $a4, $a4 ] => $a4 ],
  93  [ [ $a4, $a5 ] => $a4 ],
  94  [ [ $a4, $a6 ] => $x_ver ],
  95
  96  [ [ $a5, $a5 ] => $a5 ],
  97  [ [ $a5, $a6 ] => $a6 ],
  98
  99  [ [ $a6, $a6 ] => $a6 ],
 100
 101  [ [ ($a1) x 3 ] => $a1 ],
 102  [ [ ($a2) x 4 ] => $a2 ],
 103 );
 104
 105 for my $t (@tests) {
 106  my ($args, $exp) = @$t;
 107
 108  for my $r (0 .. 1) {
 109   my @a = @$args;
 110   @a = reverse @a if $r;
 111
 112   my $desc = join ' AND ', map "'$_'", @a;
 113
 114   my $a   = eval { A->and(@a) };
 115   my $err = $@;
 116
 117   if (ref $exp eq 'Regexp') {
 118    like $err, $exp, "$desc should fail";
 119   } else {
 120    cmp_ok $a, '==', $exp, "$desc == '$exp'";
 121   }
 122  }
 123 }