t/05-explicit-cleanee.t

   1 #!/usr/bin/env perl
   2 use warnings;
   3 use strict;
   4
   5 use FindBin;
   6 use lib "$FindBin::Bin/lib";
   7 use Test::More tests => 2019;
   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;
  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 }