X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Faccessors_xs_cachedwarn.t;h=eecc8dff23908ec4a07fec0366b57434d24a1f59;hb=1ed25f9e8d107a7311c579da0d23afa253c01268;hp=f7c2c6b1f9ed535f51bcbcc00a88cd17f49fd2bd;hpb=5808b2245979b6d4c0582c10892e8526aa00d673;p=p5sagit%2FClass-Accessor-Grouped.git diff --git a/t/accessors_xs_cachedwarn.t b/t/accessors_xs_cachedwarn.t index f7c2c6b..eecc8df 100644 --- a/t/accessors_xs_cachedwarn.t +++ b/t/accessors_xs_cachedwarn.t @@ -1,3 +1,11 @@ +my $has_threads; +BEGIN { eval ' + use 5.008004; # older perls get confused by $SIG fiddling + use threads; + use threads::shared; + $has_threads = 1; +' } + use strict; use warnings; use Test::More; @@ -20,20 +28,26 @@ BEGIN { use AccessorGroupsSubclass; -my $obj = AccessorGroupsSubclass->new; -my $deferred_stub = AccessorGroupsSubclass->can('singlefield'); -my $obj2 = AccessorGroups->new; - my @w; +share(@w) if $has_threads; + { - local $SIG{__WARN__} = sub { push @w, @_ }; - is ($obj->$deferred_stub(1), 1, 'Set'); - is ($obj->$deferred_stub, 1, 'Get'); - is ($obj->$deferred_stub(2), 2, 'ReSet'); - is ($obj->$deferred_stub, 2, 'ReGet'); - - is ($obj->singlefield, 2, 'Normal get'); - is ($obj2->singlefield, undef, 'Normal get on unrelated object'); + my $obj = AccessorGroupsSubclass->new; + my $deferred_stub = AccessorGroupsSubclass->can('singlefield'); + my $obj2 = AccessorGroups->new; + + my $todo = sub { + local $SIG{__WARN__} = sub { push @w, @_ }; + is ($obj->$deferred_stub(1), 1, 'Set'); + is ($obj->$deferred_stub, 1, 'Get'); + is ($obj->$deferred_stub(2), 2, 'ReSet'); + is ($obj->$deferred_stub, 2, 'ReGet'); + + is ($obj->singlefield, 2, 'Normal get'); + is ($obj2->singlefield, undef, 'Normal get on unrelated object'); + }; + + $has_threads ? threads->create( $todo )->join : $todo->(); } is (@w, 3, '3 warnings total');