#!perl
use
strict;
use
warnings;
use
Test::Base::Less;
my
$class_name
=
'Subroutines::ProhibitUnusedPrivateSubroutines'
;
filters {
params
=> [
qw/eval/
],
# TODO wrong!
};
for
my
$block
(blocks) {
my
$violations
= fetch_violations(
$class_name
,
$block
->input,
$block
->params);
is
scalar
@$violations
,
$block
->failures,
$block
->dscr;
}
done_testing;
__DATA__
===
--- dscr: basic failure
--- failures: 1
--- params:
--- input
sub _foo {};
===
--- dscr: basic pass
--- failures: 0
--- params:
--- input
sub _foo {};
_foo;
===
--- dscr: Method call is OK
--- failures: 0
--- params:
--- input
sub _foo {};
$self->_foo();
===
--- dscr: Method call where invocant is "shift"
--- failures: 0
--- params:
--- input
sub _foo {};
shift->_foo;
===
--- dscr: other builtin-function followed by private method call
--- failures: 0
--- params:
--- input
sub _foo {};
pop->_foo();
===
--- dscr: Maybe non-obvious failure
--- failures: 1
--- params:
--- input
sub _foo {};
$self->SUPER::_foo();
===
--- dscr: Forward references do not count
--- failures: 0
--- params:
--- input
sub _foo;
===
--- dscr: User-configured exceptions.
--- failures: 0
--- params: {prohibit_unused_private_subroutines => {allow => '_foo _bar _baz'}}
--- input
sub _foo {};
sub _bar ($) {};
sub _baz : method {};
===
--- dscr: private_name_regex passing
--- failures: 0
--- params: {prohibit_unused_private_subroutines => {private_name_regex => '_(?:_|parse_)\w+'}}
--- input
sub __foo {};
sub __bar ($) {};
sub __baz : method {};
sub _parse_my_argument {};
===
--- dscr: private_name_regex failure
--- failures: 3
--- params: {prohibit_unused_private_subroutines => {private_name_regex => '_(?:_)\w+'}}
--- input
sub _foo {};
sub _bar ($) {};
sub _baz : method {};
===
--- dscr: reference to private subroutine
--- failures: 0
--- params:
--- input
sub _foo {};
my $bar = \&_foo;
===
--- dscr: goto to private subroutine
--- failures: 0
--- params:
--- input
sub _foo {};
sub bar {
goto &_foo;
}
===
--- dscr: private subroutine used in overload
--- failures: 0
--- params:
--- input
use overload ( cmp => '_compare' );
sub _compare {};
===
--- dscr: private subroutine used in overload, the bad way
--- failures: 0
--- params:
--- input
use overload ( cmp => _compare => foo => 'bar' );
sub _compare {};
===
--- dscr: private subroutine used in overload, by reference
--- failures: 0
--- params:
--- input
use overload ( cmp => \&_compare );
sub _compare {};
===
--- dscr: recursive but otherwise unused subroutine
--- failures: 2
--- params:
--- input
sub _foo {
my ( $arg ) = @_;
return $arg <= 1 ? $arg : $arg * _foo( $arg - 1 );
}
sub _bar {
--$_[0] > 0 and goto &_bar;
return $_[0];
}
===
--- dscr: recursive subroutine called outside itself
--- failures: 0
--- params:
--- input
_foo( 3 );
sub _foo {
my ( $arg ) = @_;
return $arg <= 1 ? $arg : $arg * _foo( $arg - 1 );
}
_bar( 1.3 );
sub _bar {
--$_[0] > 0 and goto &_bar;
return $_[0];
}
===
--- dscr: subroutine declared in someone else's name space
--- failures: 0
--- params:
--- input
sub _Foo::_foo {}
===
--- dscr: Subroutine called in replacement portion of s/.../.../e
--- failures: 0
--- params:
--- input
s/ ( foo ) / _bar( $1 ) /smxe;
sub _bar {
my ( $foo ) = @_;
return $foo x 3;
}
===
--- dscr: Subroutine called in regexp interpolation
--- failures: 0
--- params:
--- input
s/ ( foo ) /@{[ _bar( $1 ) ]}/smx;
sub _bar {
my ( $foo ) = @_;
return $foo x 3;
}
===
--- dscr: Subroutine called in regexp embedded code
--- failures: 0
--- params:
--- input
m/ (?{ _foo() }) /smx;
sub _foo {
return 'bar';
}
===
--- dscr: RT 61311: dies on "&_name" call
--- failures: 0
--- params:
--- input
sub first {
&_second();
}
sub _second {
print "A private sub\n";
}
===
--- dscr: no lint
--- failures: 0
--- params:
--- input
use strict;
sub _foo { ## no lint
# do something
};
$self->SUPER::_foo();