File: 02f_point_inh_proxies_at_original.t

package info (click to toggle)
libsub-wrappackages-perl 2.02-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 292 kB
  • sloc: perl: 664; sh: 3; makefile: 2
file content (37 lines) | stat: -rw-r--r-- 1,029 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
#!/usr/bin/perl -w
# What if b inherits from a, a::foo is wrapped, and then
#   b::* are wrapped with wrap_inherited?

use strict;
use Test::More tests => 4;
use Data::Dumper;

my $pre; my $post;

use lib 't/lib'; use a;
# first wrap everything in a ...
use Sub::WrapPackages (
    packages       => [qw(a)],
    wrap_inherited => 1,
    pre            => sub { $pre++ },
    post           => sub { $post++ },
);

a->a_list(1,2,3);
ok($pre == $post && $post == 1, "pre and post are working");

# now load b and wrap everything in it, including inherited methods
eval 'use b';
Sub::WrapPackages::wrapsubs (
    packages => [qw(b)],
    wrap_inherited => 1,
    pre            => sub { $pre++ },
    post           => sub { $post++ },
);

$pre = $post = 0;
b->b_function();
ok($pre == $post && $post == 1, "pre and post work in the child for a non-inherited method");
$pre = $post = 0;
is_deeply([b->a_list()], [qw(in sub a_list)], "inherited method returns OK");
ok($pre == $post && $pre == 1, "and pre/post only get run once");