From: Vincent Pit Date: Sun, 29 Nov 2009 14:10:08 +0000 (+0100) Subject: Test C::D::G::Atom->{new,new_from_ebuild} X-Git-Tag: v0.09~3 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=9e50d0a5cd63e13e194009d6fbdedb75e75eaa5e;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git 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 2e4782e..4e83022 100644 --- 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 dd35ad6..4166d5c 100644 --- 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 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 => '= $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 1bb1bfb..5770471 100644 --- 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 7aec331..36819ab 100644 --- 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'"; }