xt/extra/sqlite_deadlock.t

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