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
  20     DBIx::Class::Optional::Dependencies->skip_without( 'test_rdbms_' . lc $type );
  21
  22     my @dsn = $type eq 'SQLite'
  23       ? ( DBICTest->_database(sqlite_use_file => 1) )
  24       : ( @ENV{map { "DBICTEST_${type}_${_}" } qw/DSN USER PASS/} )
  25     ;
  26
  27     my $schema = DBICTest::Schema->connect (@dsn);
  28
  29     # emulate a singleton-factory, just cache the object *somewhere in a different package*
  30     # to induce out-of-order destruction
  31     $DBICTest::FakeSchemaFactory::schema = $schema;
  32
  33     ok (!$schema->storage->connected, "$type: start disconnected");
  34
  35     $schema->txn_do (sub {
  36
  37       ok ($schema->storage->connected, "$type: transaction starts connected");
  38
  39       my $pid = fork();
  40       SKIP: {
  41         skip "Fork failed: $!", 1 if (! defined $pid);
  42
  43         if ($pid) {
  44           note "Parent $$ sleeping...";
  45           wait();
  46           note "Parent $$ woken up after child $pid exit";
  47         }
  48         else {
  49           note "Child $$ terminating";
  50           undef $DBICTest::FakeSchemaFactory::schema;
  51           exit 0;
  52         }
  53
  54         ok ($schema->storage->connected, "$type: parent still connected (in txn_do)");
  55       }
  56     });
  57
  58     ok ($schema->storage->connected, "$type: parent still connected (outside of txn_do)");
  59
  60     undef $DBICTest::FakeSchemaFactory::schema;
  61   }
  62 }
  63
  64 done_testing;