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 );
27 @DBICTest::ATTRTEST::ISA = 'DBIx::Class';
31 'DBICTest::ATTRTEST::attr',
35 attributes => [qw( ResultSet )],
36 package => 'DBICTest::ATTRTEST',
40 is $s, \&DBICTest::ATTRTEST::attr, 'Same cref installed';
42 is DBICTest::ATTRTEST::attr(), 42, 'Sub properly installed and callable';
45 [ attributes::get( $s ) ],
47 'Attribute installed',
48 unless $^V =~ /c/; # FIXME work around https://github.com/perl11/cperl/issues/147
51 # Test that secondary attribute application works
54 DBICTest::ATTRTEST->can('attr'),
56 'SomethingNobodyUses',
59 # and that double-application also works
62 DBICTest::ATTRTEST->can('attr'),
63 'SomethingNobodyUses',
67 [ sort( attributes::get( $s ) )],
69 qw( ResultSet SomethingNobodyUses method ),
71 # before 5.10/5.8.9 internal reserved would get doubled, sigh
73 # FIXME - perhaps need to weed them out somehow at FETCH_CODE_ATTRIBUTES
74 # time...? In any case - this is not important at this stage
75 ( modver_gt_or_eq( attributes => '0.08' ) ? () : 'method' )
77 'Secondary attributes installed',
78 unless $^V =~ /c/; # FIXME work around https://github.com/perl11/cperl/issues/147
81 DBICTest::ATTRTEST->_attr_cache->{$s},
83 qw( ResultSet SomethingNobodyUses ),
85 # after 5.10/5.8.9 FETCH_CODE_ATTRIBUTES is never called for reserved
86 # attribute names, so there is nothing for DBIC to see
88 # FIXME - perhaps need to teach ->_attr to reinvoke attributes::get() ?
89 # In any case - this is not important at this stage
90 ( modver_gt_or_eq( attributes => '0.08' ) ? () : 'method' )
92 'Attributes visible in DBIC-specific attribute API',
98 SKIP: { skip "Skipping the thread test: $skip_threads", 1 }
103 threads->create(sub {
105 threads->create(sub {
108 select( undef, undef, undef, 0.2 ); # without this many tasty crashes even on latest perls
112 select( undef, undef, undef, 0.2 ); # without this many tasty crashes even on latest perls