Commit | Line | Data |
fcfe7810 |
1 | #!/usr/bin/env perl |
2 | use warnings; |
3 | use strict; |
4 | |
5 | use FindBin; |
6 | use lib "$FindBin::Bin/lib"; |
8de3b21e |
7 | use Test::More tests => 2019; |
fcfe7810 |
8 | |
9 | use_ok('CleaneeTarget'); |
10 | |
11 | ok CleaneeTarget->can('IGNORED'), 'symbol in exception list still there'; |
12 | ok CleaneeTarget->can('NOTAWAY'), 'symbol after import call still there'; |
13 | ok !CleaneeTarget->can('AWAY'), 'normal symbol has disappeared'; |
14 | |
15 | ok !CleaneeTarget->can('x_foo'), 'explicitely removed disappeared (1/2)'; |
16 | ok CleaneeTarget->can('x_bar'), 'not in explicit removal and still there'; |
17 | ok !CleaneeTarget->can('x_baz'), 'explicitely removed disappeared (2/2)'; |
18 | |
19 | ok !CleaneeTarget->can('d_foo'), 'directly removed disappeared (1/2)'; |
20 | ok CleaneeTarget->can('d_bar'), 'not in direct removal and still there'; |
21 | ok !CleaneeTarget->can('d_baz'), 'directly removed disappeared (2/2)'; |
22 | |
23 | my @values = qw( 23 27 17 XFOO XBAR XBAZ 7 8 9 ); |
24 | is(CleaneeTarget->summary->[ $_ ], $values[ $_ ], sprintf('testing sub in cleanee (%d/%d)', $_ + 1, scalar @values)) |
25 | for 0 .. $#values; |
8de3b21e |
26 | |
27 | |
28 | # some torture |
29 | SKIP: { |
30 | |
31 | skip "This part of the test segfaults perl $] with both tie() and B::H::EOS." |
32 | . ' Actual code (e.g. DBIx::Class) works fine so did not investigate further', |
33 | 2000 if $] < 5.008003; |
34 | |
35 | local @INC = @INC; |
36 | my @code; |
37 | unshift @INC, sub { |
38 | |
39 | if ($_[1] =~ /CleaneeTarget\/No(\d+)/) { |
40 | my @code = ( |
41 | "package CleaneeTarget::No${1};", |
42 | "sub x_foo { 'XFOO' }", |
43 | "sub x_bar { 'XBAR' }", |
44 | |
45 | "use CleaneeBridgeExplicit;", |
46 | |
47 | "1;", |
48 | ); |
49 | |
50 | return sub { return 0 unless @code; $_ = shift @code; 1; } |
51 | } |
52 | else { |
53 | return (); |
54 | } |
55 | }; |
56 | |
57 | for (1..1000) { |
58 | my $pkg = "CleaneeTarget::No${_}"; |
59 | |
60 | my @val = require "CleaneeTarget/No${_}.pm"; |
61 | |
62 | ok !$pkg->can('x_foo'), 'explicitely removed disappeared'; |
63 | ok $pkg->can('x_bar'), 'not in explicit removal and still there'; |
64 | } |
65 | } |