From: Peter Rabbitson <ribasushi@cpan.org>
Date: Wed, 4 Dec 2013 06:19:42 +0000 (+0100)
Subject: Windows fork is not only slow - it plain breaks on multiple requires :(
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=db9c03868eadb17753aa7224f2f9816aa2cc1b91;p=dbsrgits%2FDBIx-Class-Historic.git

Windows fork is not only slow - it plain breaks on multiple requires :(

Stop using pseudofork on the lesser platform altogether
---

diff --git a/xt/standalone_testschema_resultclasses.t b/xt/standalone_testschema_resultclasses.t
index 38278c0..95acd43 100644
--- a/xt/standalone_testschema_resultclasses.t
+++ b/xt/standalone_testschema_resultclasses.t
@@ -1,35 +1,56 @@
 use warnings;
 use strict;
 
+use DBIx::Class::_Util 'sigwarn_silencer';
+use if DBIx::Class::_ENV_::BROKEN_FORK, 'threads';
+
 use Test::More;
 use File::Find;
+use Time::HiRes 'sleep';
 
-use DBIx::Class::_Util 'sigwarn_silencer';
 
 use lib 't/lib';
 
+my $worker = sub {
+  my $fn = shift;
+
+  if (my @offenders = grep { $_ ne 'DBIx/Class/_Util.pm' } grep { $_ =~ /(^|\/)DBI/ } keys %INC) {
+    die "Wtf - DBI* modules present in %INC: @offenders";
+  }
+
+  local $SIG{__WARN__} = sigwarn_silencer( qr/\bdeprecated\b/i );
+  require( ( $fn =~ m| t/lib/ (.+) |x )[0] ); # untaint and strip lib-part (. is unavailable under -T)
+
+  return 42;
+};
+
+
 find({
   wanted => sub {
 
     return unless ( -f $_ and $_ =~ /\.pm$/ );
 
-    my $pid = fork();
-    if (! defined $pid) {
-      die "fork failed: $!"
+    if (DBIx::Class::_ENV_::BROKEN_FORK) {
+      # older perls crash if threads are spawned way too quickly, sleep for 100 msecs
+      my $t = threads->create(sub { $worker->($_) });
+      sleep 0.1;
+      is ($t->join, 42, "Thread loading $_ did not finish successfully")
+        || diag ($t->can('error') ? $t->error : 'threads.pm too old to retrieve the error :(' );
     }
-    elsif (!$pid) {
-      if (my @offenders = grep { $_ ne 'DBIx/Class/_Util.pm' } grep { $_ =~ /(^|\/)DBI/ } keys %INC) {
-        die "Wtf - DBI* modules present in %INC: @offenders";
+    else {
+      my $pid = fork();
+      if (! defined $pid) {
+        die "fork failed: $!"
+      }
+      elsif (!$pid) {
+        $worker->($_);
+        exit 0;
       }
 
-      local $SIG{__WARN__} = sigwarn_silencer( qr/\bdeprecated\b/i );
-      require( ( $_ =~ m| t/lib/ (.+) |x )[0] ); # untaint and strip lib-part (. is unavailable under -T)
-      exit 0;
+      is ( waitpid($pid, 0), $pid, "Fork $pid terminated sucessfully");
+      my $ex = $? >> 8;
+      is ( $ex, 0, "Loading $_ ($pid) exitted with $ex" );
     }
-
-    is ( waitpid($pid, 0), $pid, "Fork $pid terminated sucessfully");
-    my $ex = $? >> 8;
-    is ( $ex, 0, "Loading $_ ($pid) exitted with $ex" );
   },
 
   no_chdir => 1,