t/accessors_xs.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   plan skip_all => "Sub::Name not available"
  20     unless eval { require Sub::Name };
  21
  22   require Class::Accessor::Grouped;
  23
  24   my $xsa_ver = $Class::Accessor::Grouped::__minimum_xsa_version;
  25   eval {
  26     require Class::XSAccessor;
  27     Class::XSAccessor->VERSION ($xsa_ver);
  28   };
  29   plan skip_all => "Class::XSAccessor >= $xsa_ver not available"
  30     if $@;
  31 }
  32
  33 # rerun the regular 3 tests under XSAccessor
  34 our $SUBTESTING = 1;
  35 $Class::Accessor::Grouped::USE_XS = 1;
  36
  37 for my $tname (qw/accessors.t accessors_ro.t accessors_wo.t/) {
  38
  39   my $pass = 1;
  40   share($pass) if $has_threads;
  41
  42   my $todo = sub {
  43     note "\nTesting $tname with USE_XS (pass @{[ $pass++ ]})\n\n";
  44
  45     my ($tfn) = catfile($Bin, $tname) =~ /(.+)/;
  46
  47     for (
  48       qw|AccessorGroups.pm AccessorGroups/BeenThereDoneThat.pm AccessorGroupsRO.pm AccessorGroupsSubclass.pm AccessorGroupsParent.pm AccessorGroupsWO.pm|,
  49       File::Spec::Unix->catfile ($tfn),
  50     ) {
  51       delete $INC{$_};
  52       no strict 'refs';
  53       if (my ($mod) = $_ =~ /(.+)\.pm$/ ) {
  54         %{"${mod}::"} = ();
  55       }
  56     }
  57
  58     local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /subroutine .+ redefined/i };
  59
  60     do($tfn);
  61   };
  62
  63   if ($has_threads) {
  64     threads->create(sub {
  65       threads->create(sub {
  66         $todo->() for (1,2) }
  67       )->join;
  68       $todo->() for (1,2);
  69     })->join for (1,2)
  70   }
  71   else {
  72     $todo->() for (1, 2);
  73   }
  74 }
  75
  76 done_testing;