t/accessors_pp.t

   1 my $has_threads;
   2 BEGIN { eval '
   3   use 5.008001;
   4   use threads;
   5   use threads::shared;
   6   $has_threads = 1;
   7 ' }
   8
   9 use strict;
  10 use warnings;
  11 no warnings 'once';
  12 use FindBin qw($Bin);
  13 use File::Spec::Functions;
  14 use File::Spec::Unix (); # need this for %INC munging
  15 use Test::More;
  16 use lib 't/lib';
  17
  18 BEGIN {
  19   local $ENV{DEVEL_HIDE_VERBOSE} = 0;
  20   eval { require Devel::Hide };
  21   if ($@) {
  22     eval { require Sub::Name };
  23     plan skip_all => "Devel::Hide required for this test in presence of Sub::Name"
  24       if ! $@;
  25   }
  26   else {
  27     Devel::Hide->import('Sub/Name.pm');
  28   }
  29   require Class::Accessor::Grouped;
  30 }
  31
  32
  33 # rerun the regular 3 tests under the assumption of no Sub::Name
  34 our $SUBTESTING = 1;
  35 for my $tname (qw/accessors.t accessors_ro.t accessors_wo.t/) {
  36
  37   my $pass = 1;
  38   share($pass) if $has_threads;
  39
  40   my $todo = sub {
  41     note "\nTesting $tname without Sub::Name (pass @{[ $pass ++ ]})\n\n";
  42
  43     my ($tfn) = catfile($Bin, $tname) =~ /(.+)/;
  44
  45     for (
  46       qw|AccessorGroups.pm AccessorGroups/BeenThereDoneThat.pm AccessorGroupsRO.pm AccessorGroupsSubclass.pm AccessorGroupsParent.pm AccessorGroupsWO.pm|,
  47       File::Spec::Unix->catfile ($tfn),
  48     ) {
  49       delete $INC{$_};
  50       no strict 'refs';
  51       if (my ($mod) = $_ =~ /(.+)\.pm$/ ) {
  52         %{"${mod}::"} = ();
  53       }
  54     }
  55
  56     local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /subroutine .+ redefined/i };
  57
  58     do($tfn);
  59
  60     666;
  61   };
  62
  63   if ($has_threads) {
  64     for (1,2) {
  65       is (
  66         threads->create(sub {
  67
  68           # nested threading of this sort badly blows up on 5.10.0 (fixed with 5.10.1)
  69           unless ($] > 5.009 and $] < 5.010001) {
  70             is (
  71
  72               threads->create(sub {
  73                 $todo->();
  74               })->join,
  75
  76               666,
  77
  78               'Innner thread joined ok',
  79             );
  80
  81             is ($todo->(), 666, "Intermediate result ok");
  82           }
  83
  84           return 777;
  85         })->join,
  86
  87         777,
  88
  89         'Outer thread joined ok',
  90       );
  91
  92       is ($todo->(), 666, "Unthreaded run ok") for (1,2);
  93     }
  94   }
  95   else {
  96     is ($todo->(), 666, "Unthreaded run ok") for (1,2);
  97   }
  98 }
  99
 100 done_testing;