The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

#!perl -w
use strict;
use C;
subtest 'exception' => sub {
throws_ok(
sub { Sub::Inspector->new(undef) },
qr(isn't a subroutine reference)
);
for my $method (qw(file line name proto prototype attrs attributes)) {
throws_ok(
sub { Sub::Inspector->$method(undef) },
qr(isn't a subroutine reference)
);
}
};
subtest 'file, line, name' => sub {
_test(C->can('parent_method'), (
['file', file(__FILE__)->dir->subdir('lib')->file('ParentClass.pm')->absolute],
['line', 5],
['name', 'parent_method'],
));
};
subtest 'proto' => sub {
_test(C->can('try'), (
['proto', '&;@'],
['prototype', '&;@'],
));
_test(C->can('plain'), (
['proto', undef],
['prototype', undef],
));
};
subtest 'attr' => sub {
_test_array(C->can('has_attr'), (
['attrs', [qw(lvalue)]],
['attributes', [qw(lvalue)]],
));
_test_array(C->can('has_multi_attrs'), (
['attrs', [qw(lvalue method)]],
['attributes', [qw(lvalue method)]],
));
_test_array(C->can('plain'), (
['attrs', []],
['attributes', []],
));
};
sub _test {
my ($code, @data) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $ins = Sub::Inspector->new($code);
for (@data) {
my ($method, $expected) = @{$_};
is($ins->$method, $expected);
is(Sub::Inspector->$method($code), $expected);
}
}
sub _test_array {
my ($code, @data) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
local $Data::Dumper::Indent = 1;
local $Data::Dumper::Terse = 1;
my $is_deeply2 = sub { is(Dumper($_[0]), Dumper($_[1])) };
my $ins = Sub::Inspector->new($code);
for (@data) {
my ($method, $expected) = @{$_};
is_deeply([$ins->$method], $expected);
is_deeply([Sub::Inspector->$method($code)], $expected);
}
}
done_testing;