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