- Remove useless vestigial pessimization in Ordered.pm for cases
when the position column is part of a unique constraint
- Fix dbicadmin to no longer ignore the documented 'config' option
+ - The schema-resultsource entanglement is now much more robust
+ under threads
* Misc
- Centralized leak-checks for all instances of DBICTest::Schema
'Class::Accessor::Grouped' => '0.10002',
'Class::C3::Componentised' => '1.0009',
'Class::Inspector' => '1.24',
+ 'Class::Method::Modifiers' => '1.06',
'Config::Any' => '0.20',
'Context::Preserve' => '0.01',
'Data::Dumper::Concise' => '2.020',
--- /dev/null
+# This is just a concept-test. If works as intended will ship in its own
+# right as Devel::GlobalDestruction::PP or perhaps even as part of rafls
+# D::GD itself
+
+package # hide from pause
+ DBIx::Class::GlobalDestruction;
+
+use strict;
+use warnings;
+
+use base 'Exporter';
+our @EXPORT = 'in_global_destruction';
+
+use DBIx::Class::Exception;
+
+if (defined ${^GLOBAL_PHASE}) {
+ eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }';
+}
+elsif (eval { require Devel::GlobalDestruction }) { # use the XS version if available
+ *in_global_destruction = \&Devel::GlobalDestruction::in_global_destruction;
+}
+else {
+ my ($in_global_destruction, $before_is_installed);
+
+ eval <<'PP_IGD';
+
+sub in_global_destruction () { $in_global_destruction }
+
+END {
+ # SpeedyCGI runs END blocks every cycle but keeps object instances
+ # hence we have to disable the globaldestroy hatch, and rely on the
+ # eval traps (which appears to work, but are risky done so late)
+ $in_global_destruction = 1 unless $CGI::SpeedyCGI::i_am_speedy;
+}
+
+# threads do not execute the global ENDs (it would be stupid). However
+# one can register a new END via simple string eval within a thread, and
+# achieve the same result. A logical place to do this would be CLONE, which
+# is claimed to run in the context of the new thread. However this does
+# not really seem to be the case - any END evaled in a CLONE is ignored :(
+# Hence blatantly hooking threads::create
+if ($INC{'threads.pm'}) {
+ require Class::Method::Modifiers;
+ Class::Method::Modifiers::install_modifier( threads => before => create => sub {
+ my $orig_target_cref = $_[1];
+ $_[1] = sub {
+ { local $@; eval 'END { $in_global_destruction = 1 }' }
+ $orig_target_cref->();
+ };
+ });
+ $before_is_installed = 1;
+}
+
+# just in case threads got loaded after DBIC (silly)
+sub CLONE {
+ DBIx::Class::Exception->throw("You must load the 'threads' module before @{[ __PACKAGE__ ]}")
+ unless $before_is_installed;
+}
+
+PP_IGD
+
+}
+
+1;
use DBIx::Class::Exception;
use DBIx::Class::Carp;
+use DBIx::Class::GlobalDestruction;
use Try::Tiny;
use List::Util 'first';
use Scalar::Util qw/blessed weaken isweak/;
});
}
-{
- my $global_phase_destroy;
-
- # SpeedyCGI runs END blocks every cycle but keeps object instances
- # hence we have to disable the globaldestroy hatch, and rely on the
- # eval trap below (which appears to work, but is risky done so late)
- END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy }
-
- sub DESTROY {
- return if $global_phase_destroy;
+my $global_phase_destroy;
+sub DESTROY {
+ return if $global_phase_destroy ||= in_global_destruction;
######
# !!! ACHTUNG !!!!
# we are trying to save to reattach back to the source we are destroying.
# The relevant code checking refcounts is in ::Schema::DESTROY()
- # if we are not a schema instance holder - we don't matter
- return if(
- ! ref $_[0]->{schema}
- or
- isweak $_[0]->{schema}
- );
-
- # weaken our schema hold forcing the schema to find somewhere else to live
- # during global destruction (if we have not yet bailed out) this will throw
- # which will serve as a signal to not try doing anything else
- local $@;
- eval {
- weaken $_[0]->{schema};
- 1;
- } or do {
- $global_phase_destroy = 1;
- return;
- };
+ # if we are not a schema instance holder - we don't matter
+ return if(
+ ! ref $_[0]->{schema}
+ or
+ isweak $_[0]->{schema}
+ );
+ # weaken our schema hold forcing the schema to find somewhere else to live
+ # during global destruction (if we have not yet bailed out) this will throw
+ # which will serve as a signal to not try doing anything else
+ # however beware - on older perls the exception seems randomly untrappable
+ # due to some weird race condition during thread joining :(((
+ local $@;
+ eval {
+ weaken $_[0]->{schema};
# if schema is still there reintroduce ourselves with strong refs back to us
if ($_[0]->{schema}) {
$srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
}
}
- }
+
+ 1;
+ } or do {
+ $global_phase_destroy = 1;
+ };
+
+ return;
}
sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
use Scalar::Util 'weaken';
use Sub::Name 'subname';
use B 'svref_2object';
+use DBIx::Class::GlobalDestruction;
use namespace::clean;
use base qw/DBIx::Class/;
return $source;
}
-{
- my $global_phase_destroy;
-
- # SpeedyCGI runs END blocks every cycle but keeps object instances
- # hence we have to disable the globaldestroy hatch, and rely on the
- # eval trap below (which appears to work, but is risky done so late)
- END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy }
-
- sub DESTROY {
- return if $global_phase_destroy;
-
- my $self = shift;
- my $srcs = $self->source_registrations;
-
- for my $moniker (keys %$srcs) {
- # find first source that is not about to be GCed (someone other than $self
- # holds a reference to it) and reattach to it, weakening our own link
- #
- # during global destruction (if we have not yet bailed out) this will throw
- # which will serve as a signal to not try doing anything else
- if (ref $srcs->{$moniker} and svref_2object($srcs->{$moniker})->REFCNT > 1) {
- local $@;
- eval {
- $srcs->{$moniker}->schema($self);
- 1;
- } or do {
- $global_phase_destroy = 1;
- last;
- };
+my $global_phase_destroy;
+sub DESTROY {
+ return if $global_phase_destroy ||= in_global_destruction;
+ my $self = shift;
+ my $srcs = $self->source_registrations;
+
+ for my $moniker (keys %$srcs) {
+ # find first source that is not about to be GCed (someone other than $self
+ # holds a reference to it) and reattach to it, weakening our own link
+ #
+ # during global destruction (if we have not yet bailed out) this should throw
+ # which will serve as a signal to not try doing anything else
+ # however beware - on older perls the exception seems randomly untrappable
+ # due to some weird race condition during thread joining :(((
+ if (ref $srcs->{$moniker} and svref_2object($srcs->{$moniker})->REFCNT > 1) {
+ local $@;
+ eval {
+ $srcs->{$moniker}->schema($self);
weaken $srcs->{$moniker};
- last;
- }
+ 1;
+ } or do {
+ $global_phase_destroy = 1;
+ };
+
+ last;
}
}
}
--- /dev/null
+use Config;
+BEGIN {
+ unless ($Config{useithreads}) {
+ print "1..0 # SKIP your perl does not support ithreads\n";
+ exit 0;
+ }
+}
+use threads;
+
+use strict;
+use warnings;
+use Test::More;
+
+plan skip_all => 'DBIC does not actively support threads before perl 5.8.5'
+ if $] < '5.008005';
+
+use lib qw(t/lib);
+use DBICTest;
+
+# README: If you set the env var to a number greater than 10,
+# we will use that many children
+my $num_children = $ENV{DBICTEST_THREAD_STRESS} || 1;
+if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
+ $num_children = 10;
+}
+
+my $schema = DBICTest->init_schema(no_deploy => 1);
+isa_ok ($schema, 'DBICTest::Schema');
+
+my @threads;
+push @threads, threads->create(sub {
+ my $rsrc = $schema->source('Artist');
+ undef $schema;
+ isa_ok ($rsrc->schema, 'DBICTest::Schema');
+ my $s2 = $rsrc->schema->clone;
+
+ sleep 1; # without this many tasty crashes
+}) for (1.. $num_children);
+ok(1, "past spawning");
+
+$_->join for @threads;
+ok(1, "past joining");
+
+done_testing;
use Test::More;
use Test::Exception;
-plan skip_all => 'Minimum of perl 5.8.5 required for thread tests (DBD::Pg mandated)'
+plan skip_all => 'DBIC does not actively support threads before perl 5.8.5'
if $] < '5.008005';
use DBIx::Class::Optional::Dependencies ();
use Test::More;
-plan skip_all => 'Minimum of perl 5.8.5 required for thread tests (DBD::Pg mandated)'
+plan skip_all => 'DBIC does not actively support threads before perl 5.8.5'
if $] < '5.008005';
use DBIx::Class::Optional::Dependencies ();
# from the parent
'DBIx::Class::ResultSet::Pager',
+ # this is not part of the inheritance tree (plus is a temporary fix anyway)
+ 'DBIx::Class::GlobalDestruction',
+
# Moo does not name its generated methods, fix pending
'DBIx::Class::Storage::BlockRunner',
) };
'DBIx::Class::ResultSource::*' => { skip => 1 },
'DBIx::Class::Storage::Statistics' => { skip => 1 },
'DBIx::Class::Storage::DBI::Replicated::Types' => { skip => 1 },
+ 'DBIx::Class::GlobalDestruction' => { skip => 1 },
'DBIx::Class::Storage::BlockRunner' => { skip => 1 }, # temporary
# test some specific components whose parents are exempt below
projects / dbsrgits/DBIx-Class.git / commitdiff