Skip to content

Commit

Permalink
Ignore method calls for Class::Load
Browse files Browse the repository at this point in the history
  • Loading branch information
kentfredric committed Apr 9, 2016
1 parent b57c196 commit 71219d7
Show file tree
Hide file tree
Showing 2 changed files with 40 additions and 4 deletions.
12 changes: 8 additions & 4 deletions lib/Perl/PrereqScanner/Scanner/Class/Load.pm
Original file line number Diff line number Diff line change
Expand Up @@ -22,9 +22,7 @@ my %functions = (
try_load_class => '_get_pn',
load_optional_class => '_get_pn',
);
my %subs = (
map { ( "Class::Load::$_" => [ $functions{$_}, $_ ], "$_" => [ $functions{$_}, $_ ], ) } keys %functions
);
my %subs = ( map { ( "Class::Load::$_" => [ $functions{$_}, $_ ], "$_" => [ $functions{$_}, $_ ], ) } keys %functions );

=for Pod::Coverage scan_for_prereqs
Expand All @@ -47,13 +45,19 @@ sub scan_for_prereqs {
sub {
return q[] unless $_[1]->isa('PPI::Statement');
my (@children) = $_[1]->schildren;
while ( my $child = shift @children ) {
my ( $child, $previous );
while (@children) {
$previous = $child;
$child = shift @children;

# Match sub call
next
unless $child->isa('PPI::Token::Word')
and $child->literal =~ qr/$literal_re/sx;

# Skip methods
next if $previous and $previous->isa('PPI::Token::Operator') and q{->} eq $previous->content;

# Handle a list of arguments as token->next
if ( $children[0]->isa('PPI::Structure::List') ) {
push @interesting, [ $child->literal, shift @children ];
Expand Down
32 changes: 32 additions & 0 deletions t/class-load/ignore.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,32 @@
use strict;
use warnings;

use Test::More;

# ABSTRACT: Basic class load tests

use Perl::PrereqScanner;
my $scanner = Perl::PrereqScanner->new( extra_scanners => [qw( Class::Load )], );
my $prereqs = $scanner->scan_string(
q[
use Class::Load;
$thing->load_class("My::ClassA");
$thing->try_load_class(q{My::ClassB});
$thing->load_optional_class('My::ClassC');
]
)->as_string_hash;

my $diag_needed;

$diag_needed = 1 unless ok( !exists $prereqs->{"My::ClassA"}, "ClassA reported" );
$diag_needed = 1 unless ok( !exists $prereqs->{"My::ClassB"}, "ClassB reported" );
$diag_needed = 1 unless ok( !exists $prereqs->{"My::ClassC"}, "ClassC reported" );

if ($diag_needed) {
diag explain $prereqs;
}

done_testing;

0 comments on commit 71219d7

Please sign in to comment.