Permalink
Browse files

Initial support for Test::Requires

Test::Requires import and test_requires() calls are now supported.

Signed-off-by: Petr Šabata <contyk@redhat.com>
  • Loading branch information...
contyk committed Jan 9, 2015
1 parent 9a06b3a commit 5216d41952e16fe8b040fa68a8061de7b5970db0
Showing with 96 additions and 4 deletions.
  1. +0 −1 TODO
  2. +1 −1 lib/Tangerine.pm
  3. +1 −1 lib/Tangerine/Utils.pm
  4. +86 −0 lib/Tangerine/hook/testrequires.pm
  5. +6 −0 lib/Tangerine/hook/tests.pm
  6. +2 −1 t/00-compile.t
View
1 TODO
@@ -1,7 +1,6 @@
Something to work on:
* Parse EXPR form of eval
* Test::Requires
* A new Tangerine method to report required perl version
* Allow users to specify additional hooks to run
* Convert versions in use statements as required, e.g.
View
@@ -21,7 +21,7 @@ has uses => {};
my %hooks;
$hooks{prov} = [ qw(package) ];
$hooks{req} = [ qw(require) ];
$hooks{use} = [ qw(use list prefixedlist anymoose if mooselike tests xxx) ];
$hooks{use} = [ qw(use list prefixedlist anymoose if mooselike testrequires tests xxx) ];
sub run {
my $self = shift;
View
@@ -9,7 +9,7 @@ sub stripquotelike {
my @filtered = map {
if (/^('|").*$/o) {
substr $_, 1, -1
} elsif (/^(\(|\[).*$/so) {
} elsif (/^(\(|\[|\{).*$/so) {
stripquotelike(split /,|=>/so, substr $_, 1, -1)
} elsif (/^qq?\s*[^\w](.*)[^\w]$/so) {
$1
@@ -0,0 +1,86 @@
package Tangerine::hook::testrequires;
use 5.010;
use strict;
use warnings;
use List::MoreUtils qw(any);
use Mo;
use Tangerine::HookData;
use Tangerine::Occurence;
use Tangerine::Utils qw(stripquotelike);
extends 'Tangerine::Hook';
sub run {
my ($self, $s) = @_;
my %found;
# TODO: This is a use hook
if ($self->type eq 'use' &&
(any { $s->[0] eq $_ } qw(use no)) && scalar(@$s) > 2 &&
$s->[1] eq 'Test::Requires') {
my ($version) = $s->[2] =~ /^(\d.*)$/o;
$version //= '';
return if !$version && stripquotelike($s->[2]) =~ /^v?5(\..*)?$/;
my $voffset = $version ? 3 : 2;
my @args;
if (scalar(@$s) > $voffset) {
return if $s->[$voffset] eq ';';
@args = @$s;
@args = @args[($voffset) .. $#args];
@args = stripquotelike(@args);
}
if (substr($s->[$voffset], 0, 1) eq '{') {
%found = @args;
} else {
%found = map { $_ => '' } @args;
}
# TODO: This is a require hook
} elsif ($self->type eq 'req' &&
$s->[0] eq 'test_requires' && scalar(@$s) > 1) {
return if $s->[1] eq ';';
my @args = stripquotelike((@$s)[1..$#$s]);
$found{$args[0]} = $args[1] && $args[1] ne ';' ? $args[1] : '';
} else {
return
}
return Tangerine::HookData->new(
modules => {
map {
( $_ => Tangerine::Occurence->new(version => $found{$_}) )
} keys %found,
},
)
}
1;
__END__
=pod
=encoding utf8
=head1 NAME
Tangerine::hook::testrequire - Process Test::Requires calls.
=head1 DESCRIPTION
This module inspects L<Test::Requires> use and test_requires() calls
and inspects their arguments, checking which modules will the
subroutines load.
=head1 SEE ALSO
L<Tangerine>, L<Test::Requires>
=head1 AUTHOR
Petr Šabata <contyk@redhat.com>
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2015 Petr Šabata
See LICENSE for licensing details.
=cut
@@ -18,6 +18,12 @@ sub run {
return Tangerine::HookData->new( hooks => [
Tangerine::hook::testloading->new(type => 'req') ] );
}
if ((any { $s->[0] eq $_ } qw(use no)) && scalar(@$s) > 1 &&
$s->[1] eq 'Test::Requires') {
require Tangerine::hook::testrequires;
return Tangerine::HookData->new( hooks => [
Tangerine::hook::testrequires->new(type => 'req') ] );
}
return;
}
View
@@ -1,6 +1,6 @@
use strict;
use warnings;
use Test::More tests => 16;
use Test::More tests => 17;
use Test::Script;
for my $file (qw(
@@ -19,6 +19,7 @@ for my $file (qw(
lib/Tangerine/hook/require.pm
lib/Tangerine/hook/tests.pm
lib/Tangerine/hook/testloading.pm
lib/Tangerine/hook/testrequires.pm
lib/Tangerine/hook/use.pm
)) {
script_compiles($file, "$file compiles");

1 comment on commit 5216d41

@pghmcfc

This comment has been minimized.

Show comment
Hide comment
@pghmcfc

pghmcfc Aug 16, 2016

Could do with a hook like this for Test::Needs too.

Could do with a hook like this for Test::Needs too.

Please sign in to comment.