t/05-explicit-cleanee.t

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