xref: /openbsd-src/gnu/usr.bin/perl/lib/B/Deparse-subclass.t (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
1b8851fccSafresh1#!./perl
2b8851fccSafresh1
3b8851fccSafresh1# These tests are not necessarily normative, but until such time as we
4b8851fccSafresh1# publicise an API for subclassing B::Deparse they can prevent us from
5b8851fccSafresh1# gratuitously breaking conventions that CPAN modules already use.
6b8851fccSafresh1
7*3d61058aSafresh1use warnings;
8*3d61058aSafresh1use strict;
9256a93a4Safresh1use Test::More;
10b8851fccSafresh1
11b8851fccSafresh1use B::Deparse;
12b8851fccSafresh1
13b8851fccSafresh1package B::Deparse::NameMangler {
14*3d61058aSafresh1  our @ISA = "B::Deparse";
15b8851fccSafresh1  sub padname { SUPER::padname{@_} . '_groovy' }
16b8851fccSafresh1}
17b8851fccSafresh1
18b8851fccSafresh1my $nm = 'B::Deparse::NameMangler'->new;
19b8851fccSafresh1
20b8851fccSafresh1like  $nm->coderef2text(sub { my($a, $b, $c) }),
21b8851fccSafresh1      qr/\$a_groovy, \$b_groovy, \$c_groovy/,
22b8851fccSafresh1     'overriding padname works for renaming lexicals';
23b8851fccSafresh1
24b8851fccSafresh1like  $nm->coderef2text(sub { my $c; /(??{ $c })/; }),
25b8851fccSafresh1      qr/\Q(??{\E \$c_groovy/,
26b8851fccSafresh1     'overriding padname works for renaming lexicals in regexp blocks';
27256a93a4Safresh1
28256a93a4Safresh1done_testing();
29