1 files changed, 314 insertions, 0 deletions
diff --git a/t/lib/MBTest.pm b/t/lib/MBTest.pm
new file mode 100644
index 0000000..fda7f69
--- /dev/null
+++ b/t/lib/MBTest.pm
@@ -0,0 +1,314 @@
+package MBTest;
+
+use strict;
+
+use File::Spec;
+use File::Temp ();
+use File::Path ();
+
+
+# Setup the code to clean out %ENV
+BEGIN {
+    # Environment variables which might effect our testing
+    my @delete_env_keys = qw(
+        HOME
+        DEVEL_COVER_OPTIONS
+        MODULEBUILDRC
+        PERL_MB_OPT
+        HARNESS_TIMER
+        HARNESS_OPTIONS
+        HARNESS_VERBOSE
+        PREFIX
+        INSTALL_BASE
+        INSTALLDIRS
+    );
+
+    # Remember the ENV values because on VMS %ENV is global
+    # to the user, not the process.
+    my %restore_env_keys;
+
+    sub clean_env {
+        for my $key (@delete_env_keys) {
+            if( exists $ENV{$key} ) {
+                $restore_env_keys{$key} = delete $ENV{$key};
+            }
+            else {
+                delete $ENV{$key};
+            }
+        }
+    }
+
+    END {
+        while( my($key, $val) = each %restore_env_keys ) {
+            $ENV{$key} = $val;
+        }
+    }
+}
+
+
+BEGIN {
+  clean_env();
+
+  # In case the test wants to use our other bundled
+  # modules, make sure they can be loaded.
+  my $t_lib = File::Spec->catdir('t', 'bundled');
+  push @INC, $t_lib; # Let user's installed version override
+
+  # We change directories, so expand @INC and $^X to absolute paths
+  # Also add .
+  @INC = (map(File::Spec->rel2abs($_), @INC), ".");
+  $^X = File::Spec->rel2abs($^X);
+}
+
+use Exporter;
+use Test::More;
+use Config;
+use Cwd ();
+
+# We pass everything through to Test::More
+use vars qw($VERSION @ISA @EXPORT $TODO);
+@ISA = ('Exporter');
+$VERSION = 0.01_01;
+
+# We have a few extra exports, but Test::More has a special import()
+# that won't take extra additions.
+@EXPORT = (
+    qw(
+      stdout_of
+      stderr_of
+      stdout_stderr_of
+      slurp
+      find_in_path
+      check_compiler
+      have_module
+      blib_load
+      timed_out
+      $TODO
+    ),
+    @Test::More::EXPORT,
+);
+
+sub import {
+    my $class = shift;
+    my $caller = caller;
+
+    my @imports;
+
+    while (my $item = shift @_) {
+        if ($item eq 'tests' || $item eq 'skip_all') {
+            my $arg = shift @_;
+            plan($item => $arg);
+        }
+        elsif($item eq 'no_plan') {
+            plan($item);
+        }
+        else {
+            push @imports => $item;
+        }
+    }
+
+    @imports = @EXPORT unless @imports;
+
+    $class->export($caller, @imports);
+}
+
+
+########################################################################
+
+# always return to the current directory
+{
+  my $cwd;
+  # must be done in BEGIN because tmpdir uses it in BEGIN for $ENV{HOME}
+  BEGIN { 
+    $cwd = File::Spec->rel2abs(Cwd::cwd);
+  }
+
+  sub original_cwd { return $cwd }
+
+  END {
+    # Go back to where you came from!
+    chdir $cwd or die "Couldn't chdir to $cwd";
+  }
+}
+########################################################################
+
+{ # backwards compatible temp filename recipe adapted from perlfaq
+  my $tmp_count = 0;
+  my $tmp_base_name = sprintf("MB-%d-%d", $$, time());
+  sub temp_file_name {
+    sprintf("%s-%04d", $tmp_base_name, ++$tmp_count)
+  }
+}
+########################################################################
+
+# Setup a temp directory
+sub tmpdir {
+  my ($self, @args) = @_;
+  my $dir = $ENV{PERL_CORE} ? MBTest->original_cwd : File::Spec->tmpdir;
+  return File::Temp::tempdir('MB-XXXXXXXX', CLEANUP => 1, DIR => $dir, @args);
+}
+
+BEGIN {
+  $ENV{HOME} = tmpdir; # don't want .modulebuildrc or other things interfering
+}
+
+sub save_handle {
+  my ($handle, $subr) = @_;
+  my $outfile = File::Spec->catfile(File::Spec->tmpdir, temp_file_name());
+
+  local *SAVEOUT;
+  open SAVEOUT, ">&" . fileno($handle)
+    or die "Can't save output handle: $!";
+  open $handle, "> $outfile" or die "Can't create $outfile: $!";
+
+  eval {$subr->()};
+  open $handle, ">&SAVEOUT" or die "Can't restore output: $!";
+
+  my $ret = slurp($outfile);
+  1 while unlink $outfile;
+  return $ret;
+}
+
+sub stdout_of { save_handle(\*STDOUT, @_) }
+sub stderr_of { save_handle(\*STDERR, @_) }
+sub stdout_stderr_of {
+  my $subr = shift;
+  my ($stdout, $stderr);
+  $stdout = stdout_of ( sub {
+      $stderr = stderr_of( $subr )
+  });
+  return wantarray ? ($stdout, $stderr) : $stdout . $stderr;
+}
+
+sub slurp {
+  open(my $fh, '<', $_[0]) or die "Can't open $_[0]: $!";
+  local $/;
+  return scalar <$fh>;
+}
+
+# Some extensions we should know about if we're looking for executables
+sub exe_exts {
+
+  if ($^O eq 'MSWin32') {
+    return split($Config{path_sep}, $ENV{PATHEXT} || '.com;.exe;.bat');
+  }
+  if ($^O eq 'os2') {
+    return qw(.exe .com .pl .cmd .bat .sh .ksh);
+  }
+  return;
+}
+
+sub find_in_path {
+  my $thing = shift;
+
+  my @exe_ext = exe_exts();
+  if ( File::Spec->file_name_is_absolute( $thing ) ) {
+    foreach my $ext ( '', @exe_ext ) {
+      return "$thing$ext" if -e "$thing$ext";
+    }
+  }
+  else {
+    my @path = split $Config{path_sep}, $ENV{PATH};
+    foreach (@path) {
+      my $fullpath = File::Spec->catfile($_, $thing);
+      foreach my $ext ( '', @exe_ext ) {
+        return "$fullpath$ext" if -e "$fullpath$ext";
+      }
+    }
+  }
+  return;
+}
+
+sub check_compiler {
+  if ($ENV{PERL_CORE}) {
+    require IPC::Cmd;
+    if ( $Config{usecrosscompile} && !IPC::Cmd::can_run($Config{cc}) ) {
+      return;
+    }
+    else {
+      return(1,1);
+    }
+  }
+
+  local $SIG{__WARN__} = sub {};
+
+  blib_load('Module::Build');
+  my $mb = Module::Build->current;
+  $mb->verbose( 0 );
+
+  my $have_c_compiler;
+  stderr_of( sub {$have_c_compiler = $mb->have_c_compiler} );
+  # XXX link_executable() is not yet implemented for Windows
+  # and noexec tmpdir is irrelevant on Windows
+  return ($have_c_compiler, 1) if $^O eq "MSWin32";
+
+  # check noexec tmpdir
+  my $tmp_exec;
+  if ( $have_c_compiler ) {
+    my $dir = MBTest->tmpdir;
+    my $c_file = File::Spec->catfile($dir,'test.c');
+    open my $fh, ">", $c_file;
+    print {$fh} "int main() { return 0; }\n";
+    close $fh;
+    my $exe = $mb->cbuilder->link_executable(
+      objects => $mb->cbuilder->compile( source => $c_file )
+    );
+    $tmp_exec = 0 == system( $exe );
+  }
+  return ($have_c_compiler, $tmp_exec);
+}
+
+sub have_module {
+  my $module = shift;
+  return eval "require $module; 1";
+}
+
+sub blib_load {
+  # Load the given module and ensure it came from blib/, not the larger system
+  my $mod = shift;
+  have_module($mod) or die "Error loading $mod\: $@\n";
+
+  (my $path = $mod) =~ s{::}{/}g;
+  $path .= ".pm";
+  my ($pkg, $file, $line) = caller;
+  unless($ENV{PERL_CORE}) {
+    unless($INC{$path} =~ m/\bblib\b/) {
+      (my $load_from = $INC{$path}) =~ s{$path$}{};
+      die "$mod loaded from '$load_from'\nIt should have been loaded from blib.  \@INC contains:\n  ",
+      join("\n  ", @INC) . "\nFatal error occured in blib_load() at $file, line $line.\n";
+    }
+  }
+}
+
+sub timed_out {
+  my ($sub, $timeout) = @_;
+  return unless $sub;
+  $timeout ||= 60;
+
+  my $saw_alarm = 0;
+  eval {
+    local $SIG{ALRM} = sub { $saw_alarm++; die "alarm\n"; }; # NB: \n required
+    alarm $timeout;
+    $sub->();
+    alarm 0;
+  };
+  if ($@) {
+    die unless $@ eq "alarm\n";   # propagate unexpected errors
+  }
+  return $saw_alarm;
+}
+
+sub check_EUI {
+  my $timed_out;
+  stdout_stderr_of( sub {
+      $timed_out = timed_out( sub {
+          ExtUtils::Installed->new(extra_libs => [@INC])
+        }
+      );
+    }
+  );
+  return ! $timed_out;
+}
+
+1;
+# vim:ts=2:sw=2:et:sta