1use strict; use warnings; use diagnostics; 2package TestInlineSetup; 3 4use File::Path; 5use File::Spec; 6use constant IS_WIN32 => $^O eq 'MSWin32' ; 7 8sub import { 9 my ($package, $option) = @_; 10 $option ||= ''; 11} 12 13BEGIN { 14 if (exists $ENV{PERL_INSTALL_ROOT}) { 15 warn "\nIgnoring \$ENV{PERL_INSTALL_ROOT} in $0\n"; 16 delete $ENV{PERL_INSTALL_ROOT}; 17 } 18 # Suppress "Set up gcc environment ..." warning. 19 # (Affects ActivePerl only.) 20 $ENV{ACTIVEPERL_CONFIG_SILENT} = 1; 21} 22 23our $DIR; 24BEGIN { 25 ($_, $DIR) = caller(2); 26 $DIR =~ s/.*?(\w+)\.t$/$1/ or die; 27 $DIR = "_Inline_$DIR.$$"; 28 rmtree($DIR) if -d $DIR; 29 mkdir($DIR) or die "$DIR: $!\n"; 30} 31my $absdir = File::Spec->rel2abs($DIR); 32($absdir) = $absdir =~ /(.*)/; # untaint 33 34my $startpid = $$; 35END { 36 37 if($$ == $startpid) { # only when original process exits 38 39 # On Windows we need to first unload the dll's we're about to clobber. 40 # (Based on code found in ExtUtils::ParseXS) 41 if ($^O eq 'MSWin32' and defined &DynaLoader::dl_unload_file) { 42 my $match = $0; 43 $match =~ s/\\/\//g; 44 $match = '_' . (split /\//, $match)[-1]; 45 $match =~ s/\.(t|p)$//; 46 for (my $i = 0; $i < @DynaLoader::dl_modules; $i++) { 47 if ($DynaLoader::dl_modules[$i] =~ 48 /$match|\bxsmode\b|\bSoldier_|\bBAR_|\bBAZ_|\bFOO_|\bPROTO[1-4]_|\beval_/ 49 ) { 50 my $ret; #on Win32, DLLs are ref counted by OS, the DLL may be 51 do { # boot()ed from multiple psuedoforks, and have multiple refs 52 $ret = DynaLoader::dl_unload_file($DynaLoader::dl_librefs[$i]); 53 } while (IS_WIN32 && $ret); # so loop while refcount exhausted to force demapping 54 } 55 } 56 } 57 rmtree($absdir); 58 } 59} 60 611; 62