xt/extra/sqlite_deadlock.t

   1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8 use File::Temp ();
   9
  10
  11 use DBICTest;
  12
  13 plan tests => 2;
  14 my $wait_for = 120;  # how many seconds to wait
  15
  16 # don't lock anything - this is a tempfile anyway
  17 $ENV{DBICTEST_LOCK_HOLDER} = -1;
  18
  19 for my $close (0,1) {
  20
  21   my $tmp = File::Temp->new(
  22     UNLINK => 1,
  23     DIR => 't/var',
  24     SUFFIX => '.db',
  25     TEMPLATE => 'DBIxClass-XXXXXX',
  26     EXLOCK => 0,  # important for BSD and derivatives
  27   );
  28
  29   my $tmp_fn = $tmp->filename;
  30   close $tmp if $close;
  31
  32   local $SIG{ALRM} = sub { die sprintf (
  33     "Timeout of %d seconds reached (tempfile still open: %s)",
  34     $wait_for, $close ? 'No' : 'Yes'
  35   )};
  36
  37   alarm $wait_for;
  38
  39   lives_ok (sub {
  40     my $schema = DBICTest::Schema->connect ("DBI:SQLite:$tmp_fn");
  41     $schema->storage->dbh_do(sub { $_[1]->do('PRAGMA synchronous = OFF') });
  42     DBICTest->deploy_schema ($schema);
  43     DBICTest->populate_schema ($schema);
  44   });
  45
  46   alarm 0;
  47 }