7 if( ! $Config{useithreads} ) {
8 $skip_threads = 'your perl does not support ithreads';
10 elsif( "$]" < 5.008005 ) {
11 $skip_threads = 'DBIC does not actively support threads before perl 5.8.5';
13 elsif( $INC{'Devel/Cover.pm'} ) {
14 $skip_threads = 'Devel::Cover does not work with ithreads yet';
17 unless( $skip_threads ) {
24 use DBIx::Class::_Util qw( quote_sub modver_gt_or_eq );
26 ### Test the upcoming attributes support
28 @DBICTest::ATTRTEST::ISA = 'DBIx::Class';
32 'DBICTest::ATTRTEST::attr',
36 attributes => [qw( ResultSet )],
37 package => 'DBICTest::ATTRTEST',
41 is $s, \&DBICTest::ATTRTEST::attr, 'Same cref installed';
43 is DBICTest::ATTRTEST::attr(), 42, 'Sub properly installed and callable';
46 [ attributes::get( $s ) ],
48 'Attribute installed',
49 unless $^V =~ /c/; # FIXME work around https://github.com/perl11/cperl/issues/147
52 # Test that secondary attribute application works
55 DBICTest::ATTRTEST->can('attr'),
57 'SomethingNobodyUses',
60 # and that double-application also works
63 DBICTest::ATTRTEST->can('attr'),
64 'SomethingNobodyUses',
68 [ sort( attributes::get( $s ) )],
70 qw( ResultSet SomethingNobodyUses method ),
72 # before 5.10/5.8.9 internal reserved would get doubled, sigh
74 # FIXME - perhaps need to weed them out somehow at FETCH_CODE_ATTRIBUTES
75 # time...? In any case - this is not important at this stage
76 ( modver_gt_or_eq( attributes => '0.08' ) ? () : 'method' )
78 'Secondary attributes installed',
79 unless $^V =~ /c/; # FIXME work around https://github.com/perl11/cperl/issues/147
82 DBICTest::ATTRTEST->_attr_cache->{$s},
84 qw( ResultSet SomethingNobodyUses ),
86 # after 5.10/5.8.9 FETCH_CODE_ATTRIBUTES is never called for reserved
87 # attribute names, so there is nothing for DBIC to see
89 # FIXME - perhaps need to teach ->_attr to reinvoke attributes::get() ?
90 # In any case - this is not important at this stage
91 ( modver_gt_or_eq( attributes => '0.08' ) ? () : 'method' )
93 'Attributes visible in DBIC-specific attribute API',
99 SKIP: { skip "Skipping the thread test: $skip_threads", 1 }
104 threads->create(sub {
106 select( undef, undef, undef, 0.2 ); # without this many tasty crashes even on latest perls