xt/dist/loadable_standalone_testschema_resultclasses.t

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