view release on metacpan or  search on metacpan

t/32-threadtxn.t  view on Meta::CPAN

use threads;

use strict;
use warnings;

use Test::More;

plan skip_all => 'DBIO does not actively support threads before perl 5.8.5'
  if $] < '5.008005';

use Scalar::Util 'weaken';
use DBIO::Test;

my ($dsn, $user, $pass) = @ENV{map { "DBIO_TEST_PG_${_}" } qw/DSN USER PASS/};
plan skip_all => 'Set $ENV{DBIO_TEST_PG_DSN}, _USER and _PASS to run this test'
      . ' (note: creates and drops a table named cd!)' unless ($dsn && $user);

my $num_children = $ENV{DBIO_TEST_THREAD_STRESS} || 1;
if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
   $num_children = 10;
}

t/32-threadtxn.t  view on Meta::CPAN

    $parent_rs = $schema->resultset('CD')->search({ year => 1901 });
    is ($parent_rs->count, 2);
};
ok(!$@) or diag "Creation eval failed: $@";

my @children;
while(@children < $num_children) {

    my $newthread = async {
        my $tid = threads->tid;
        weaken(my $weak_schema = $schema);
        weaken(my $weak_parent_rs = $parent_rs);
        $schema->txn_do(sub {
            my $child_rs = $weak_schema->resultset('CD')->search({ year => 1901 });
            my $row = $weak_parent_rs->next;
            if($row && $row->get_column('artist') =~ /^(?:123|456)$/) {
                $weak_schema->resultset('CD')->create({ title => "test success $tid", artist => $tid, year => scalar(@children) });
            }
        });
        sleep(1);  # tasty crashes without this
    };
    die "Thread creation failed: $! $@" if !defined $newthread;