Test C::D::G::Atom->{new,new_from_ebuild}

Also fail loudly in t/30-atom-cmp.t and t/31-atom-and.t if the testcase
croaked when it shouldn't

diff --git a/MANIFEST b/MANIFEST
index 2e4782e3e217a722891af01fb24f5b8ea9ec332b..4e8302276cc14ae66a6fa09215d5936c0686b4d4 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -14,8 +14,9 @@ t/11-maps-name.t
 t/12-maps-version.t
 t/13-maps-license.t
 t/20-version.t
-t/30-atom-cmp.t
-t/31-atom-and.t
+t/30-atom-new.t
+t/31-atom-cmp.t
+t/32-atom-and.t
 t/91-pod.t
 t/92-pod-coverage.t
 t/95-portability-files.t

diff --git a/lib/CPANPLUS/Dist/Gentoo/Atom.pm b/lib/CPANPLUS/Dist/Gentoo/Atom.pm
index dd35ad6d8f3cfc67efdbf0e324acc6de1b08187a..4166d5cc090d4e1cfc7ed7d665ca2289c037af60 100644 (file)
--- a/lib/CPANPLUS/Dist/Gentoo/Atom.pm
+++ b/lib/CPANPLUS/Dist/Gentoo/Atom.pm
@@ -55,7 +55,7 @@ sub new {
   /[^\w-]/ and Carp::confess('Invalid argument') for $name, $category;
  } elsif (defined $args{atom}) {
   my $atom = $args{atom};
-  $atom =~ m{^(<|<=|=|>=|>)?([\w-]+)/([\w-]+)(?-v?($version_rx))?$}
+  $atom =~ m{^(<|<=|=|>=|>)?([\w-]+)/([\w-]+)(?:-v?($version_rx))?$}
                                                or Carp::confess('Invalid atom');
   ($range, $category, $name, $version) = ($1, $2, $3, $4);
  } else {

diff --git a/t/30-atom-new.t b/t/30-atom-new.t
new file mode 100644 (file)
index 0000000..c4dcdbe
--- /dev/null
+++ b/t/30-atom-new.t
@@ -0,0 +1,73 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 15;
+
+use CPANPLUS::Dist::Gentoo::Atom;
+
+sub A () { 'CPANPLUS::Dist::Gentoo::Atom' }
+
+my $no_info      = qr/^Not enough information/;
+my $range_no_ver = qr/^Range atoms require a valid version/;
+my $inv_atom     = qr/^Invalid atom/;
+my $inv_ebuild   = qr/^Invalid ebuild/;
+
+my $a0 = { category => 'test', name => 'a' };
+my $a1 = { category => 'test', name => 'a', version => '1.0' };
+
+my @tests = (
+ [ { }                     => $no_info ],
+ [ { category => 'test' }  => $no_info ],
+ [ $a0                     => $a0 ],
+ [ { %$a0, range => '<=' } => $range_no_ver ],
+ [ $a1                     => { %$a1, range => '=' } ],
+ [ { %$a1, range => '<=' } => { %$a1, range => '<=' } ],
+
+ [ { atom => 'test/a' }        => $a0 ],
+ [ { atom => 'test/a-1.0' }    => { %$a1, range => '=' } ],
+ [ { atom => '>=test/a-v1.0' } => { %$a1, range => '>=' } ],
+ [ { atom => '=<test/a-v1.0' } => $inv_atom ],
+ [ { atom => '>=test/a' }      => $range_no_ver ],
+
+ [ { ebuild => undef }                      => $inv_ebuild ],
+ [ { ebuild => '/wat/test/a/a.ebuild' }     => $inv_ebuild ],
+ [ { ebuild => '/wat/test/a/a-1.0.ebuild' } => { %$a1, range => '=' } ],
+ [ { ebuild => '/wat/test/a/b-1.0.ebuild' } => $inv_ebuild ],
+);
+
+my @fields = qw/range category name version ebuild/;
+
+for my $t (@tests) {
+ my ($args, $exp) = @$t;
+
+ my ($meth, @args);
+ if (exists $args->{ebuild}) {
+  $meth = 'new_from_ebuild';
+  @args = ($args->{ebuild});
+ } else {
+  $meth = 'new';
+  @args = %$args;
+ }
+
+ my $atom = eval { A->$meth(@args) };
+ my $err  = $@;
+
+ if (ref $exp eq 'Regexp') {
+  like $err, $exp;
+ } elsif ($err) {
+  fail $err;
+ } else {
+  $exp = { %$exp };
+  for (@fields) {
+   next if exists $exp->{$_};
+   $exp->{$_} = ($_ eq 'ebuild' and exists $args->{ebuild})
+                ? $args->{ebuild}
+                : undef;
+  }
+  is_deeply {
+   map { my $val = $atom->$_; $_ => (defined $val ? "$val" : undef) } @fields
+  }, $exp;
+ }
+}

diff --git a/t/30-atom-cmp.t b/t/31-atom-cmp.t
similarity index 96%
rename from t/30-atom-cmp.t
rename to t/31-atom-cmp.t
index 1bb1bfb5e5c5fdcef56d98950cbcc05333f2153c..577047114f5dc17976f143c3e2f62a87f6e74802 100644 (file)
--- a/t/30-atom-cmp.t
+++ b/t/31-atom-cmp.t
@@ -103,6 +103,8 @@ sub compare_ok {
 
  if (ref $exp eq 'Regexp') {
   like $err, $exp, "$desc should fail";
+ } elsif ($err) {
+  fail "$desc failed but shouldn't: $err";
  } else {
   is $c, $exp, "$desc == '$exp'";
  }

diff --git a/t/31-atom-and.t b/t/32-atom-and.t
similarity index 97%
rename from t/31-atom-and.t
rename to t/32-atom-and.t
index 7aec331fd07544cc7b89e12fd3c54cecb6a42620..36819abd84576d62fd5c5b357c5a73a33a4cb682 100644 (file)
--- a/t/31-atom-and.t
+++ b/t/32-atom-and.t
@@ -116,6 +116,8 @@ for my $t (@tests) {
 
   if (ref $exp eq 'Regexp') {
    like $err, $exp, "$desc should fail";
+  } elsif ($err) {
+   fail "$desc failed but shouldn't: $err";
   } else {
    cmp_ok $a, '==', $exp, "$desc == '$exp'";
   }