Commit | Line | Data |
1ed25f9e |
1 | my $has_threads; |
2 | BEGIN { eval ' |
5c87a5b1 |
3 | use 5.008005; # older perls segfault on threading under CXSA |
1ed25f9e |
4 | use threads; |
5 | use threads::shared; |
6 | $has_threads = 1; |
7 | ' } |
8 | |
9540f4e4 |
9 | use strict; |
10 | use warnings; |
1ed25f9e |
11 | no warnings 'once'; |
9540f4e4 |
12 | use FindBin qw($Bin); |
13 | use File::Spec::Functions; |
cfed50f2 |
14 | use File::Spec::Unix (); # need this for %INC munging |
9540f4e4 |
15 | use Test::More; |
16 | use lib 't/lib'; |
17 | |
8019c4d8 |
18 | BEGIN { |
7a1ba8bd |
19 | plan skip_all => "Sub::Name not available" |
20 | unless eval { require Sub::Name }; |
21 | |
ba8c183b |
22 | require Class::Accessor::Grouped; |
7a1ba8bd |
23 | |
ba8c183b |
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 $@; |
8019c4d8 |
31 | } |
9540f4e4 |
32 | |
28344104 |
33 | # rerun the regular 3 tests under XSAccessor |
ed606987 |
34 | our $SUBTESTING = 1; |
8019c4d8 |
35 | $Class::Accessor::Grouped::USE_XS = 1; |
cfed50f2 |
36 | |
ed606987 |
37 | for my $tname (qw/accessors.t accessors_ro.t accessors_wo.t/) { |
38 | |
1ed25f9e |
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"; |
ed606987 |
44 | |
2f4e57f4 |
45 | my ($tfn) = catfile($Bin, $tname) =~ /(.+)/; |
cfed50f2 |
46 | |
f7cf6867 |
47 | for ( |
5808b224 |
48 | qw|AccessorGroups.pm AccessorGroups/BeenThereDoneThat.pm AccessorGroupsRO.pm AccessorGroupsSubclass.pm AccessorGroupsParent.pm AccessorGroupsWO.pm|, |
cfed50f2 |
49 | File::Spec::Unix->catfile ($tfn), |
f7cf6867 |
50 | ) { |
51 | delete $INC{$_}; |
52 | no strict 'refs'; |
53 | if (my ($mod) = $_ =~ /(.+)\.pm$/ ) { |
54 | %{"${mod}::"} = (); |
55 | } |
56 | } |
cfed50f2 |
57 | |
58 | local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /subroutine .+ redefined/i }; |
59 | |
60 | do($tfn); |
40f3dfeb |
61 | |
62 | 666; |
1ed25f9e |
63 | }; |
64 | |
65 | if ($has_threads) { |
40f3dfeb |
66 | for (1,2) { |
67 | is ( |
68 | threads->create(sub { |
270b8b0f |
69 | |
70 | # nested threading of this sort badly blows up on 5.10.0 (fixed with 5.10.1) |
71 | unless ($] > 5.009 and $] < 5.010001) { |
72 | is ( |
73 | |
74 | threads->create(sub { |
75 | $todo->(); |
76 | })->join, |
77 | |
78 | 666, |
79 | |
80 | 'Innner thread joined ok', |
81 | ); |
82 | |
83 | is ($todo->(), 666, "Intermediate result ok"); |
84 | } |
85 | |
86 | return 777; |
40f3dfeb |
87 | })->join, |
270b8b0f |
88 | |
40f3dfeb |
89 | 777, |
270b8b0f |
90 | |
40f3dfeb |
91 | 'Outer thread joined ok', |
92 | ); |
93 | |
94 | is ($todo->(), 666, "Unthreaded run ok") for (1,2); |
95 | } |
1ed25f9e |
96 | } |
97 | else { |
40f3dfeb |
98 | is ($todo->(), 666, "Unthreaded run ok") for (1,2); |
ed606987 |
99 | } |
8019c4d8 |
100 | } |
101 | |
102 | done_testing; |