File: zzzzzzz_sqlite_deadlock.t

package info (click to toggle)
libdbix-class-perl 0.08123-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 3,520 kB
  • ctags: 1,695
  • sloc: perl: 19,821; sql: 353; makefile: 10
file content (41 lines) | stat: -rw-r--r-- 784 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
use strict;
use warnings;

use Test::More;
use Test::Exception;
use lib 't/lib';

use File::Temp ();
use DBICTest;
use DBICTest::Schema;

plan tests => 2;
my $wait_for = 30;  # how many seconds to wait

for my $close (0,1) {

  my $tmp = File::Temp->new(
    UNLINK => 1,
    TMPDIR => 1,
    SUFFIX => '.sqlite',
    EXLOCK => 0,  # important for BSD and derivatives
  );

  my $tmp_fn = $tmp->filename;
  close $tmp if $close;

  local $SIG{ALRM} = sub { die sprintf (
    "Timeout of %d seconds reached (tempfile still open: %s)",
    $wait_for, $close ? 'No' : 'Yes'
  )};

  alarm $wait_for;

  lives_ok (sub {
    my $schema = DBICTest::Schema->connect ("DBI:SQLite:$tmp_fn");
    DBICTest->deploy_schema ($schema);
    #DBICTest->populate_schema ($schema);
  });

  alarm 0;
}