This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
As well as @INC, also convert $^X to an absolute path in MBTest.
[perl5.git] / lib / Module / Build / 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 our other bundled
13   # modules, make sure they can be loaded.
14   my $t_lib = File::Spec->catdir('t', 'bundled');
15
16   unless ($ENV{PERL_CORE}) {
17     push @INC, $t_lib; # Let user's installed version override
18   } else {
19     # We change directories, so expand @INC and $^X to absolute paths
20     # Also add .
21     @INC = (map(File::Spec->rel2abs($_), @INC), ".");
22     $^X = File::Spec->rel2abs($^X);
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   ensure_blib
58 );
59 push @EXPORT, @extra_exports;
60 __PACKAGE__->export(scalar caller, @extra_exports);
61 # XXX ^-- that should really happen in import()
62 ########################################################################
63
64 { # Setup a temp directory if it doesn't exist
65   my $cwd = Cwd::cwd;
66   my $tmp = File::Spec->catdir( $cwd, 't', '_tmp' . $$);
67   mkdir $tmp, 0777 unless -d $tmp;
68
69   sub tmpdir { $tmp }
70   END {
71     if(-d $tmp) {
72       # Go back to where you came from!
73       chdir $cwd or die "Couldn't chdir to $cwd";
74       File::Path::rmtree($tmp) or diag "cannot clean dir '$tmp'";
75     }
76   }
77 }
78 ########################################################################
79
80 { # backwards compatible temp filename recipe adapted from perlfaq
81   my $tmp_count = 0;
82   my $tmp_base_name = sprintf("%d-%d", $$, time());
83   sub temp_file_name {
84     sprintf("%s-%04d", $tmp_base_name, ++$tmp_count)
85   }
86 }
87 ########################################################################
88
89 sub save_handle {
90   my ($handle, $subr) = @_;
91   my $outfile = temp_file_name();
92
93   local *SAVEOUT;
94   open SAVEOUT, ">&" . fileno($handle)
95     or die "Can't save output handle: $!";
96   open $handle, "> $outfile" or die "Can't create $outfile: $!";
97
98   eval {$subr->()};
99   open $handle, ">&SAVEOUT" or die "Can't restore output: $!";
100
101   my $ret = slurp($outfile);
102   1 while unlink $outfile;
103   return $ret;
104 }
105
106 sub stdout_of { save_handle(\*STDOUT, @_) }
107 sub stderr_of { save_handle(\*STDERR, @_) }
108 sub stdout_stderr_of {
109   my $subr = shift;
110   my ($stdout, $stderr);
111   $stdout = stdout_of ( sub {
112       $stderr = stderr_of( $subr )
113   });
114   return ($stdout, $stderr);
115 }
116
117 sub slurp {
118   my $fh = IO::File->new($_[0]) or die "Can't open $_[0]: $!";
119   local $/;
120   return scalar <$fh>;
121 }
122
123 # Some extensions we should know about if we're looking for executables
124 sub exe_exts {
125
126   if ($^O eq 'MSWin32') {
127     return split($Config{path_sep}, $ENV{PATHEXT} || '.com;.exe;.bat');
128   }
129   if ($^O eq 'os2') {
130     return qw(.exe .com .pl .cmd .bat .sh .ksh);
131   }
132   return;
133 }
134
135 sub find_in_path {
136   my $thing = shift;
137   
138   my @path = split $Config{path_sep}, $ENV{PATH};
139   my @exe_ext = exe_exts();
140   foreach (@path) {
141     my $fullpath = File::Spec->catfile($_, $thing);
142     foreach my $ext ( '', @exe_ext ) {
143       return "$fullpath$ext" if -e "$fullpath$ext";
144     }
145   }
146   return;
147 }
148
149 # returns ($have_c_compiler, $C_support_feature);
150 sub check_compiler {
151   return (1,1) if $ENV{PERL_CORE};
152
153   local $SIG{__WARN__} = sub {};
154
155   my $mb = Module::Build->current;
156   $mb->verbose( 0 );
157
158   my $have_c_compiler;
159   stderr_of( sub {$have_c_compiler = $mb->have_c_compiler} );
160
161   return ($have_c_compiler, $mb->feature('C_support'));
162 }
163
164 sub have_module {
165   my $module = shift;
166   return eval "use $module; 1";
167 }
168
169 sub ensure_blib {
170   # Make sure the given module was loaded from blib/, not the larger system
171   my $mod = shift;
172   (my $path = $mod) =~ s{::}{/}g;
173   
174  SKIP: {
175     skip "no blib in core", 1 if $ENV{PERL_CORE};
176     like $INC{"$path.pm"}, qr/\bblib\b/, "Make sure $mod was loaded from blib/";
177   }
178 }
179
180 1;
181 # vim:ts=2:sw=2:et:sta