Get tests working under `prove -lrswTj10`
[p5sagit/Class-Accessor-Grouped.git] / 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;