t/storage/global_destruction.t

   1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 # so we can see the retry exceptions (if any)
   9 BEGIN { $ENV{DBIC_STORAGE_RETRY_DEBUG} = 1 }
  10
  11 use DBIx::Class::Optional::Dependencies ();
  12
  13
  14 use DBICTest;
  15
  16 for my $type (qw/PG MYSQL SQLite/) {
  17
  18   SKIP: {
  19     my @dsn = $type eq 'SQLite'
  20       ? DBICTest->_database(sqlite_use_file => 1)
  21       : do {
  22         skip "Skipping $type tests without DBICTEST_${type}_DSN", 1
  23           unless $ENV{"DBICTEST_${type}_DSN"};
  24         @ENV{map { "DBICTEST_${type}_${_}" } qw/DSN USER PASS/}
  25       }
  26     ;
  27
  28     if ($type eq 'PG') {
  29       skip "skipping Pg tests without dependencies installed", 1
  30         unless DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_pg');
  31     }
  32     elsif ($type eq 'MYSQL') {
  33       skip "skipping MySQL tests without dependencies installed", 1
  34         unless DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_mysql');
  35     }
  36
  37     my $schema = DBICTest::Schema->connect (@dsn);
  38
  39     # emulate a singleton-factory, just cache the object *somewhere in a different package*
  40     # to induce out-of-order destruction
  41     $DBICTest::FakeSchemaFactory::schema = $schema;
  42
  43     ok (!$schema->storage->connected, "$type: start disconnected");
  44
  45     $schema->txn_do (sub {
  46
  47       ok ($schema->storage->connected, "$type: transaction starts connected");
  48
  49       my $pid = fork();
  50       SKIP: {
  51         skip "Fork failed: $!", 1 if (! defined $pid);
  52
  53         if ($pid) {
  54           note "Parent $$ sleeping...";
  55           wait();
  56           note "Parent $$ woken up after child $pid exit";
  57         }
  58         else {
  59           note "Child $$ terminating";
  60           undef $DBICTest::FakeSchemaFactory::schema;
  61           exit 0;
  62         }
  63
  64         ok ($schema->storage->connected, "$type: parent still connected (in txn_do)");
  65       }
  66     });
  67
  68     ok ($schema->storage->connected, "$type: parent still connected (outside of txn_do)");
  69
  70     undef $DBICTest::FakeSchemaFactory::schema;
  71   }
  72 }
  73
  74 done_testing;