Commit | Line | Data |
1ed25f9e |
1 | my $has_threads; |
2 | BEGIN { eval ' |
3 | use 5.008001; |
4 | use threads; |
5 | use threads::shared; |
6 | $has_threads = 1; |
7 | ' } |
8 | |
85ccab9a |
9 | use strict; |
10 | use warnings; |
1ed25f9e |
11 | no warnings 'once'; |
85ccab9a |
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 { |
716410c9 |
19 | local $ENV{DEVEL_HIDE_VERBOSE} = 0; |
85ccab9a |
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 | |
ed606987 |
32 | |
85ccab9a |
33 | # rerun the regular 3 tests under the assumption of no Sub::Name |
ed606987 |
34 | our $SUBTESTING = 1; |
35 | for my $tname (qw/accessors.t accessors_ro.t accessors_wo.t/) { |
36 | |
1ed25f9e |
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"; |
85ccab9a |
42 | |
2f4e57f4 |
43 | my ($tfn) = catfile($Bin, $tname) =~ /(.+)/; |
85ccab9a |
44 | |
40f3dfeb |
45 | for ( |
46 | qw|AccessorGroups.pm AccessorGroups/BeenThereDoneThat.pm AccessorGroupsRO.pm AccessorGroupsSubclass.pm AccessorGroupsParent.pm AccessorGroupsWO.pm|, |
85ccab9a |
47 | File::Spec::Unix->catfile ($tfn), |
40f3dfeb |
48 | ) { |
49 | delete $INC{$_}; |
50 | no strict 'refs'; |
51 | if (my ($mod) = $_ =~ /(.+)\.pm$/ ) { |
52 | %{"${mod}::"} = (); |
53 | } |
54 | } |
85ccab9a |
55 | |
56 | local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /subroutine .+ redefined/i }; |
57 | |
58 | do($tfn); |
40f3dfeb |
59 | |
60 | 666; |
1ed25f9e |
61 | }; |
85ccab9a |
62 | |
1ed25f9e |
63 | if ($has_threads) { |
40f3dfeb |
64 | for (1,2) { |
65 | is ( |
66 | threads->create(sub { |
270b8b0f |
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; |
40f3dfeb |
85 | })->join, |
270b8b0f |
86 | |
40f3dfeb |
87 | 777, |
270b8b0f |
88 | |
40f3dfeb |
89 | 'Outer thread joined ok', |
90 | ); |
91 | |
92 | is ($todo->(), 666, "Unthreaded run ok") for (1,2); |
93 | } |
1ed25f9e |
94 | } |
95 | else { |
40f3dfeb |
96 | is ($todo->(), 666, "Unthreaded run ok") for (1,2); |
ed606987 |
97 | } |
85ccab9a |
98 | } |
99 | |
100 | done_testing; |