X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F51threadtxn.t;h=e6cc3ac1540e963d38943dc1babab29e7fca3810;hb=8d6b1478d;hp=84a4c3ddda58a590e42f5e8f1097ab51481f0182;hpb=ec6415a9f63389db5a76f593c2d1686015ca95cd;p=dbsrgits%2FDBIx-Class.git diff --git a/t/51threadtxn.t b/t/51threadtxn.t index 84a4c3d..e6cc3ac 100644 --- a/t/51threadtxn.t +++ b/t/51threadtxn.t @@ -1,38 +1,43 @@ -use strict; -use warnings; -use Test::More; -use Config; - # README: If you set the env var to a number greater than 10, # we will use that many children +use Config; BEGIN { - plan skip_all => 'Your perl does not support ithreads' - if !$Config{useithreads}; + 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 DBIx::Class::Optional::Dependencies (); +use Scalar::Util 'weaken'; use lib qw(t/lib); +use DBICTest; my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/}; plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test' . ' (note: creates and drops a table named artist!)' unless ($dsn && $user); +plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('rdbms_pg') + unless DBIx::Class::Optional::Dependencies->req_ok_for ('rdbms_pg'); -my $num_children = $ENV{DBICTEST_THREAD_STRESS}; -plan skip_all => 'Set $ENV{DBICTEST_THREAD_STRESS} to run this test' - unless $num_children; - +my $num_children = $ENV{DBICTEST_THREAD_STRESS} || 1; if($num_children !~ /^[0-9]+$/ || $num_children < 10) { $num_children = 10; } use_ok('DBICTest::Schema'); -diag "\n\nIt is ok if you see series of 'Attempt to free unreferenced scalar: ...' warnings during this test\n " - if $] < '5.008005'; - -my $schema = DBICTest::Schema->connection($dsn, $user, $pass, { AutoCommit => 1, RaiseError => 1, PrintError => 0 }); +my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { AutoCommit => 1, RaiseError => 1, PrintError => 0 }); my $parent_rs; @@ -58,16 +63,16 @@ while(@children < $num_children) { my $newthread = async { my $tid = threads->tid; - # my $dbh = $schema->storage->dbh; - + weaken(my $weak_schema = $schema); + weaken(my $weak_parent_rs = $parent_rs); $schema->txn_do(sub { - my $child_rs = $schema->resultset('CD')->search({ year => 1901 }); - my $row = $parent_rs->next; + my $child_rs = $weak_schema->resultset('CD')->search({ year => 1901 }); + my $row = $weak_parent_rs->next; if($row && $row->get_column('artist') =~ /^(?:123|456)$/) { - $schema->resultset('CD')->create({ title => "test success $tid", artist => $tid, year => scalar(@children) }); + $weak_schema->resultset('CD')->create({ title => "test success $tid", artist => $tid, year => scalar(@children) }); } }); - sleep(3); + sleep(1); # tasty crashes without this }; die "Thread creation failed: $! $@" if !defined $newthread; push(@children, $newthread);