xt/standalone_testschema_resultclasses.t

   1 use warnings;
   2 use strict;
   3
   4 use DBIx::Class::_Util 'sigwarn_silencer';
   5 use if DBIx::Class::_ENV_::BROKEN_FORK, 'threads';
   6
   7 use Test::More;
   8 use File::Find;
   9 use Time::HiRes 'sleep';
  10
  11
  12 use lib 't/lib';
  13
  14 my $worker = sub {
  15   my $fn = shift;
  16
  17   if (my @offenders = grep { $_ !~ m{DBIx/Class/(?:_Util|Carp)\.pm} } grep { $_ =~ /(^|\/)DBI/ } keys %INC) {
  18     die "Wtf - DBI* modules present in %INC: @offenders";
  19   }
  20
  21   local $SIG{__WARN__} = sigwarn_silencer( qr/\bdeprecated\b/i );
  22   require( ( $fn =~ m| t/lib/ (.+) |x )[0] ); # untaint and strip lib-part (. is unavailable under -T)
  23
  24   return 42;
  25 };
  26
  27
  28 find({
  29   wanted => sub {
  30
  31     return unless ( -f $_ and $_ =~ /\.pm$/ );
  32
  33     if (DBIx::Class::_ENV_::BROKEN_FORK) {
  34       # older perls crash if threads are spawned way too quickly, sleep for 100 msecs
  35       my $t = threads->create(sub { $worker->($_) });
  36       sleep 0.1;
  37       is ($t->join, 42, "Thread loading $_ did not finish successfully")
  38         || diag ($t->can('error') ? $t->error : 'threads.pm too old to retrieve the error :(' );
  39     }
  40     else {
  41       my $pid = fork();
  42       if (! defined $pid) {
  43         die "fork failed: $!"
  44       }
  45       elsif (!$pid) {
  46         $worker->($_);
  47         exit 0;
  48       }
  49
  50       is ( waitpid($pid, 0), $pid, "Fork $pid terminated sucessfully");
  51       my $ex = $? >> 8;
  52       is ( $ex, 0, "Loading $_ ($pid) exitted with $ex" );
  53     }
  54   },
  55
  56   no_chdir => 1,
  57 }, 't/lib/DBICTest/Schema/');
  58
  59 done_testing;