git.maemo.org Git - dh-make-perl/blob - dev/i386/libmodule-build-perl/libmodule-build-perl-0.2808.01/t/lib/MBTest.pm

   1 package MBTest;
   2
   3 use strict;
   4
   5 use File::Spec;
   6 use File::Path ();
   7
   8 BEGIN {
   9   # Make sure none of our tests load the users ~/.modulebuildrc file
  10   $ENV{MODULEBUILDRC} = 'NONE';
  11
  12   # In case the test wants to use Test::More or our other bundled
  13   # modules, make sure they can be loaded.  They'll still do "use
  14   # Test::More" in the test script.
  15   my $t_lib = File::Spec->catdir('t', 'bundled');
  16
  17   unless ($ENV{PERL_CORE}) {
  18     push @INC, $t_lib; # Let user's installed version override
  19   } else {
  20     # We change directories, so expand @INC to absolute paths
  21     # Also add .
  22     @INC = (map(File::Spec->rel2abs($_), @INC), ".");
  23
  24     # we are in 't', go up a level so we don't create t/t/_tmp
  25     chdir '..' or die "Couldn't chdir to ..";
  26
  27     push @INC, File::Spec->catdir(qw/lib Module Build/, $t_lib);
  28
  29     # make sure children get @INC pointing to uninstalled files
  30     require Cwd;
  31     $ENV{PERL5LIB} = File::Spec->catdir(Cwd::cwd(), 'lib');
  32   }
  33 }
  34
  35 use Exporter;
  36 use Test::More;
  37 use Config;
  38 use Cwd ();
  39
  40 # We pass everything through to Test::More
  41 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
  42 $VERSION = 0.01;
  43 @ISA = qw(Test::More); # Test::More isa Exporter
  44 @EXPORT = @Test::More::EXPORT;
  45 %EXPORT_TAGS = %Test::More::EXPORT_TAGS;
  46
  47 # We have a few extra exports, but Test::More has a special import()
  48 # that won't take extra additions.
  49 my @extra_exports = qw(
  50   stdout_of
  51   stderr_of
  52   stdout_stderr_of
  53   slurp
  54   find_in_path
  55   check_compiler
  56   have_module
  57 );
  58 push @EXPORT, @extra_exports;
  59 __PACKAGE__->export(scalar caller, @extra_exports);
  60 # XXX ^-- that should really happen in import()
  61 ########################################################################
  62
  63 { # Setup a temp directory if it doesn't exist
  64   my $cwd = Cwd::cwd;
  65   my $tmp = File::Spec->catdir( $cwd, 't', '_tmp.' . $$);
  66   mkdir $tmp, 0777 unless -d $tmp;
  67
  68   sub tmpdir { $tmp }
  69   END {
  70     if(-d $tmp) {
  71       File::Path::rmtree($tmp) or warn "cannot clean dir '$tmp'";
  72     }
  73   }
  74 }
  75 ########################################################################
  76
  77 { # backwards compatible temp filename recipe adapted from perlfaq
  78   my $tmp_count = 0;
  79   my $tmp_base_name = sprintf("%d-%d", $$, time());
  80   sub temp_file_name {
  81     sprintf("%s-%04d", $tmp_base_name, ++$tmp_count)
  82   }
  83 }
  84 ########################################################################
  85
  86 sub save_handle {
  87   my ($handle, $subr) = @_;
  88   my $outfile = temp_file_name();
  89
  90   local *SAVEOUT;
  91   open SAVEOUT, ">&" . fileno($handle)
  92     or die "Can't save output handle: $!";
  93   open $handle, "> $outfile" or die "Can't create $outfile: $!";
  94
  95   eval {$subr->()};
  96   open $handle, ">&SAVEOUT" or die "Can't restore output: $!";
  97
  98   my $ret = slurp($outfile);
  99   1 while unlink $outfile;
 100   return $ret;
 101 }
 102
 103 sub stdout_of { save_handle(\*STDOUT, @_) }
 104 sub stderr_of { save_handle(\*STDERR, @_) }
 105 sub stdout_stderr_of {
 106   my $subr = shift;
 107   my ($stdout, $stderr);
 108   $stdout = stdout_of ( sub {
 109       $stderr = stderr_of( $subr )
 110   });
 111   return ($stdout, $stderr);
 112 }
 113
 114 sub slurp {
 115   my $fh = IO::File->new($_[0]) or die "Can't open $_[0]: $!";
 116   local $/;
 117   return scalar <$fh>;
 118 }
 119
 120 # Some extensions we should know about if we're looking for executables
 121 sub exe_exts {
 122
 123   if ($^O eq 'MSWin32') {
 124     return split($Config{path_sep}, $ENV{PATHEXT} || '.com;.exe;.bat');
 125   }
 126   if ($^O eq 'os2') {
 127     return qw(.exe .com .pl .cmd .bat .sh .ksh);
 128   }
 129   return;
 130 }
 131
 132 sub find_in_path {
 133   my $thing = shift;
 134
 135   my @path = split $Config{path_sep}, $ENV{PATH};
 136   my @exe_ext = exe_exts();
 137   foreach (@path) {
 138     my $fullpath = File::Spec->catfile($_, $thing);
 139     foreach my $ext ( '', @exe_ext ) {
 140       return "$fullpath$ext" if -e "$fullpath$ext";
 141     }
 142   }
 143   return;
 144 }
 145
 146 # returns ($have_c_compiler, $C_support_feature);
 147 sub check_compiler {
 148   return (1,1) if $ENV{PERL_CORE};
 149
 150   local $SIG{__WARN__} = sub {};
 151
 152   my $mb = Module::Build->current;
 153   $mb->verbose( 0 );
 154
 155   my $have_c_compiler;
 156   stderr_of( sub {$have_c_compiler = $mb->have_c_compiler} );
 157
 158   return ($have_c_compiler, $mb->feature('C_support'));
 159 }
 160
 161 sub have_module {
 162   my $module = shift;
 163   return eval "use $module; 1";
 164 }
 165
 166 1;
 167 # vim:ts=2:sw=2:et:sta