Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
fix hang in test/26fork.t on Win32
See #31 for bug description.
  • Loading branch information
bulk88 committed Dec 10, 2014
1 parent b227148 commit 92df031
Show file tree
Hide file tree
Showing 3 changed files with 28 additions and 18 deletions.
28 changes: 23 additions & 5 deletions lib/Inline/C.pm
Expand Up @@ -8,7 +8,9 @@ use Data::Dumper;
use Carp;
use Cwd qw(cwd abs_path);
use File::Spec;
use Fcntl ':flock';
use constant IS_WIN32 => $^O eq 'MSWin32';
use if !IS_WIN32, Fcntl => ':flock';
use if IS_WIN32, 'Win32::Mutex';

our @ISA = qw(Inline);

Expand Down Expand Up @@ -317,17 +319,33 @@ sub build {
croak "You need Time::HiRes for BUILD_TIMERS option:\n$@" if $@;
$total_build_time = Time::HiRes::time();
}
my $file = File::Spec->catfile($o->{API}{directory},'.lock');
open my $lockfh, '>', $file or die "lockfile $file: $!";
flock($lockfh, LOCK_EX) or die "flock: $!\n" if $^O !~ /^VMS|riscos|VOS$/;
my ($file, $lockfh);
if (IS_WIN32) {
#this can not look like a file path, or new() fails
$file = 'Inline__C_' . $o->{API}{directory} . '.lock';
$file =~ s/\\/_/g; #per CreateMutex on MSDN
$lockfh = Win32::Mutex->new(0, $file) or die "lockmutex $file: $^E";
$lockfh->wait(); #acquire, can't use 1 to new(), since if new() opens
#existing instead of create new Muxtex, it is not acquired
}
else {
$file = File::Spec->catfile($o->{API}{directory}, '.lock');
open $lockfh, '>', $file or die "lockfile $file: $!";
flock($lockfh, LOCK_EX) or die "flock: $!\n" if $^O !~ /^VMS|riscos|VOS$/;
}
$o->mkpath($o->{API}{build_dir});
$o->call('preprocess', 'Build Preprocess');
$o->call('parse', 'Build Parse');
$o->call('write_XS', 'Build Glue 1');
$o->call('write_Inline_headers', 'Build Glue 2');
$o->call('write_Makefile_PL', 'Build Glue 3');
$o->call('compile', 'Build Compile');
flock($lockfh, LOCK_UN) if $^O !~ /^VMS|riscos|VOS$/;
if (IS_WIN32) {
$lockfh->release or die "releasemutex $file: $^E";
}
else {
flock($lockfh, LOCK_UN) if $^O !~ /^VMS|riscos|VOS$/;
}
if ($o->{CONFIG}{BUILD_TIMERS}) {
$total_build_time = Time::HiRes::time() - $total_build_time;
printf STDERR "Total Build Time: %5.4f secs\n", $total_build_time;
Expand Down
12 changes: 0 additions & 12 deletions test/26fork.t
Expand Up @@ -17,21 +17,9 @@ if($^O =~ /MSWin32/i && $Config{useithreads} ne 'define') {
wait;
is($?, 0, 'child exited status 0');

if($^O =~ /MSWin32/i){
TODO: {
local $TODO = "Generally fails on MS Windows";
is($@, '', 'bind was successful');
my $x = eval { add(7,3) };
is ($@, '', 'bound func no die()');
is($x, 10, 'bound func gave right result');
}
}

else {
is($@, '', 'bind was successful');
my $x = eval { add(7,3) };
is ($@, '', 'bound func no die()');
is($x, 10, 'bound func gave right result');
}

done_testing;
6 changes: 5 additions & 1 deletion test/TestInlineSetup.pm
Expand Up @@ -3,6 +3,7 @@ package TestInlineSetup;

use File::Path;
use File::Spec;
use constant IS_WIN32 => $^O eq 'MSWin32' ;

sub import {
my ($package, $option) = @_;
Expand Down Expand Up @@ -46,7 +47,10 @@ END {
if ($DynaLoader::dl_modules[$i] =~
/$match|\bxsmode\b|\bSoldier_|\bBAR_|\bBAZ_|\bFOO_|\bPROTO[1-4]_|\beval_/
) {
DynaLoader::dl_unload_file($DynaLoader::dl_librefs[$i]);
my $ret; #on Win32, DLLs are ref counted by OS, the DLL may be
do { # boot()ed from multiple psuedoforks, and have multiple refs
$ret = DynaLoader::dl_unload_file($DynaLoader::dl_librefs[$i]);
} while (IS_WIN32 && $ret); # so loop while refcount exhausted to force demapping
}
}
}
Expand Down

0 comments on commit 92df031

Please sign in to comment.