Integrate mainline
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / t / MM_Win32.t
CommitLineData
39234879 1#!/usr/bin/perl
a9200272 2
3BEGIN {
39234879 4 if( $ENV{PERL_CORE} ) {
5 chdir 't' if -d 't';
6 @INC = '../lib';
7 }
f6d6199c 8 else {
9 unshift @INC, 't/lib';
10 }
a9200272 11}
39234879 12chdir 't';
a9200272 13
f6d6199c 14use strict;
a9200272 15use Test::More;
16
17BEGIN {
18 if ($^O =~ /MSWin32/i) {
f6d6199c 19 plan tests => 40;
a9200272 20 } else {
f49b7d07 21 plan skip_all => 'This is not Win32';
a9200272 22 }
23}
24
25use Config;
26use File::Spec;
27use File::Basename;
f6d6199c 28use ExtUtils::MM;
a9200272 29
30require_ok( 'ExtUtils::MM_Win32' );
31
f6d6199c 32# Dummy MM object until we have a real MM init method.
33my $MM = bless {
34 DIR => [],
35 NOECHO => '@',
80a5d8e7 36 XS => {},
f6d6199c 37 MAKEFILE => 'Makefile',
38 RM_RF => 'rm -rf',
39 MV => 'mv',
40 }, 'MM';
a9200272 41
a9200272 42
43# replace_manpage_separator() => tr|/|.|s ?
44{
45 my $man = 'a/path/to//something';
46 ( my $replaced = $man ) =~ tr|/|.|s;
f6d6199c 47 is( $MM->replace_manpage_separator( $man ),
a9200272 48 $replaced, 'replace_manpage_separator()' );
49}
50
51# maybe_command()
52SKIP: {
53 skip( '$ENV{COMSPEC} not set', 2 )
54 unless $ENV{COMSPEC} =~ m!((?:[a-z]:)?[^|<>]+)!i;
55 my $comspec = $1;
f6d6199c 56 is( $MM->maybe_command( $comspec ),
a9200272 57 $comspec, 'COMSPEC is a maybe_command()' );
58 ( my $comspec2 = $comspec ) =~ s|\..{3}$||;
f6d6199c 59 like( $MM->maybe_command( $comspec2 ),
a9200272 60 qr/\Q$comspec/i,
61 'maybe_command() without extension' );
62}
f6d6199c 63
64my $had_pathext = exists $ENV{PATHEXT};
a9200272 65{
66 local $ENV{PATHEXT} = '.exe';
f6d6199c 67 ok( ! $MM->maybe_command( 'not_a_command.com' ),
a9200272 68 'not a maybe_command()' );
69}
f6d6199c 70# Bug in Perl. local $ENV{FOO} won't delete the key afterward.
71delete $ENV{PATHEXT} unless $had_pathext;
a9200272 72
73# file_name_is_absolute() [Does not support UNC-paths]
74{
f6d6199c 75 ok( $MM->file_name_is_absolute( 'C:/' ),
a9200272 76 'file_name_is_absolute()' );
f6d6199c 77 ok( ! $MM->file_name_is_absolute( 'some/path/' ),
a9200272 78 'not file_name_is_absolute()' );
79
80}
81
82# find_perl()
83# Should be able to find running perl... $^X is OK on Win32
84{
85 my $my_perl = $1 if $^X =~ /(.*)/; # are we in -T or -t?
86 my( $perl, $path ) = fileparse( $my_perl );
f6d6199c 87 like( $MM->find_perl( $], [ $perl ], [ $path ] ),
a9200272 88 qr/^\Q$my_perl\E$/i, 'find_perl() finds this perl' );
89}
90
91# catdir() (calls MM_Win32->canonpath)
92{
93 my @path_eg = qw( c: trick dir/now_OK );
94
f6d6199c 95 is( $MM->catdir( @path_eg ),
a9200272 96 'C:\\trick\\dir\\now_OK', 'catdir()' );
f6d6199c 97 is( $MM->catdir( @path_eg ),
a9200272 98 File::Spec->catdir( @path_eg ),
99 'catdir() eq File::Spec->catdir()' );
100
101# catfile() (calls MM_Win32->catdir)
102 push @path_eg, 'file.ext';
103
f6d6199c 104 is( $MM->catfile( @path_eg ),
a9200272 105 'C:\\trick\\dir\\now_OK\\file.ext', 'catfile()' );
106
f6d6199c 107 is( $MM->catfile( @path_eg ),
a9200272 108 File::Spec->catfile( @path_eg ),
109 'catfile() eq File::Spec->catfile()' );
110}
111
112# init_others(): check if all keys are created and set?
113# qw( TOUCH CHMOD CP RM_F RM_RF MV NOOP TEST_F LD AR LDLOADLIBS DEV_NUL )
114{
115 my $mm_w32 = bless( {}, 'MM' );
116 $mm_w32->init_others();
117 my @keys = qw( TOUCH CHMOD CP RM_F RM_RF MV NOOP
118 TEST_F LD AR LDLOADLIBS DEV_NULL );
119 for my $key ( @keys ) {
120 ok( $mm_w32->{ $key }, "init_others: $key" );
121 }
122}
123
124# constants()
125{
126 my $mm_w32 = bless {
127 NAME => 'TestMM_Win32',
128 VERSION => '1.00',
129 VERSION_FROM => 'TestMM_Win32',
130 PM => { 'MM_Win32.pm' => 1 },
131 }, 'MM';
39234879 132
133 # XXX Hack until we have a proper init method.
134 # Flesh out some necessary keys in the MM object.
135 foreach my $key (qw(XS C O_FILES H HTMLLIBPODS HTMLSCRIPTPODS
136 MAN1PODS MAN3PODS PARENT_NAME)) {
c9d79356 137 $mm_w32->{$key} = '';
39234879 138 }
a9200272 139 my $s_PM = join( " \\\n\t", sort keys %{$mm_w32->{PM}} );
140 my $k_PM = join( " \\\n\t", %{$mm_w32->{PM}} );
141
142 like( $mm_w32->constants(),
f6d6199c 143 qr|^NAME\ =\ TestMM_Win32\s+VERSION\ =\ 1\.00.+
c9d79356 144 MAKEMAKER\ =\ \Q$INC{'ExtUtils/MakeMaker.pm'}\E\s+
145 MM_VERSION\ =\ \Q$ExtUtils::MakeMaker::VERSION\E.+
a9200272 146 VERSION_FROM\ =\ TestMM_Win32.+
147 TO_INST_PM\ =\ \Q$s_PM\E\s+
148 PM_TO_BLIB\ =\ \Q$k_PM\E
f6d6199c 149 |xs, 'constants()' );
a9200272 150
151}
152
153# path()
f6d6199c 154my $had_path = exists $ENV{PATH};
a9200272 155{
156 my @path_eg = ( qw( . .. ), 'C:\\Program Files' );
157 local $ENV{PATH} = join ';', @path_eg;
f6d6199c 158 ok( eq_array( [ $MM->path() ], [ @path_eg ] ),
a9200272 159 'path() [preset]' );
160}
f6d6199c 161# Bug in Perl. local $ENV{FOO} will not delete key afterwards.
162delete $ENV{PATH} unless $had_path;
a9200272 163
164# static_lib() should look into that
165# dynamic_bs() should look into that
166# dynamic_lib() should look into that
167
168# clean()
169{
170 my $clean = $Config{cc} =~ /^gcc/i ? 'dll.base dll.exp' : '*.pdb';
f6d6199c 171 like( $MM->clean(), qr/^clean ::\s+\Q-$(RM_F) $clean\E\s+$/m,
a9200272 172 'clean() Makefile target' );
173}
174
175# perl_archive()
176{
177 my $libperl = $Config{libperl} || 'libperl.a';
f6d6199c 178 is( $MM->perl_archive(), File::Spec->catfile('$(PERL_INC)', $libperl ),
a9200272 179 'perl_archive() should respect libperl setting' );
180}
181
182# export_list
183{
f6d6199c 184 my $mm_w32 = bless { BASEEXT => 'someext' }, 'MM';
a9200272 185 is( $mm_w32->export_list(), 'someext.def', 'export_list()' );
186}
187
188# canonpath()
189{
190 my $path = 'c:\\Program Files/SomeApp\\Progje.exe';
f6d6199c 191 is( $MM->canonpath( $path ), File::Spec->canonpath( $path ),
a9200272 192 'canonpath() eq File::Spec->canonpath' );
193}
194
195# perl_script()
196my $script_ext = '';
197my $script_name = 'mm_w32tmp';
198SKIP: {
199 local *SCRIPT;
200 skip( "Can't create temp file: $!", 4 )
201 unless open SCRIPT, "> $script_name";
202 print SCRIPT <<'EOSCRIPT';
203#! perl
204__END__
205EOSCRIPT
206 skip( "Can't write to temp file: $!", 4 )
207 unless close SCRIPT;
208 # now start tests:
f6d6199c 209 is( $MM->perl_script( $script_name ),
a9200272 210 "${script_name}$script_ext", "perl_script ($script_ext)" );
211
212 skip( "Can't rename temp file: $!", 3 )
213 unless rename $script_name, "${script_name}.pl";
214 $script_ext = '.pl';
f6d6199c 215 is( $MM->perl_script( $script_name ),
a9200272 216 "${script_name}$script_ext", "perl_script ($script_ext)" );
217
218 skip( "Can't rename temp file: $!", 2 )
219 unless rename "${script_name}$script_ext", "${script_name}.bat";
220 $script_ext = '.bat';
f6d6199c 221 is( $MM->perl_script( $script_name ),
a9200272 222 "${script_name}$script_ext", "perl_script ($script_ext)" );
223
224 skip( "Can't rename temp file: $!", 1 )
225 unless rename "${script_name}$script_ext", "${script_name}.noscript";
226 $script_ext = '.noscript';
227
f6d6199c 228 isnt( $MM->perl_script( $script_name ),
a9200272 229 "${script_name}$script_ext",
230 "not a perl_script anymore ($script_ext)" );
f6d6199c 231 is( $MM->perl_script( $script_name ), undef,
a9200272 232 "perl_script ($script_ext) returns empty" );
233}
234unlink "${script_name}$script_ext" if -f "${script_name}$script_ext";
235
236
237# pm_to_blib()
238{
f6d6199c 239 like( $MM->pm_to_blib(),
a9200272 240 qr/^pm_to_blib: \Q$(TO_INST_PM)\E.+\Q$(TOUCH) \E\$@\s+$/ms,
241 'pm_to_blib' );
242}
243
a9200272 244# tool_autosplit()
245{
246 my %attribs = ( MAXLEN => 255 );
f6d6199c 247 like( $MM->tool_autosplit( %attribs ),
a9200272 248 qr/^\#\ Usage:\ \$\(AUTOSPLITFILE\)
249 \ FileToSplit\ AutoDirToSplitInto.+
f6d6199c 250 AUTOSPLITFILE\ =\ \$\(PERLRUN\)\ .+
a9200272 251 \$AutoSplit::Maxlen=$attribs{MAXLEN};
252 /xms,
253 'tool_autosplit()' );
254}
255
256# tools_other()
257{
258 ( my $mm_w32 = bless { }, 'MM' )->init_others();
259
260 my $bin_sh = ( $Config{make} =~ /^dmake/i
261 ? "" : ($Config{sh} || 'cmd /c') . "\n" );
84a9aad5 262 $bin_sh = "SHELL = $bin_sh" if $bin_sh;
a9200272 263
264 my $tools = join "\n", map "$_ = $mm_w32->{ $_ }"
265 => qw(CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL);
266
267 like( $mm_w32->tools_other(),
84a9aad5 268 qr/^\Q$bin_sh$tools/m,
a9200272 269 'tools_other()' );
270};
271
272# xs_o() should look into that
273# top_targets() should look into that
274
a9200272 275# manifypods()
276{
277 my $mm_w32 = bless { NOECHO => '' }, 'MM';
278 like( $mm_w32->manifypods(),
279 qr/^\nmanifypods :\n\t\$\Q(NOOP)\E\n$/,
280 'manifypods() Makefile target' );
281}
282
283# dist_ci() should look into that
284# dist_core() should look into that
285
286# pasthru()
287{
288 my $pastru = "PASTHRU = " . ($Config{make} =~ /^nmake/i ? "-nologo" : "");
f6d6199c 289 is( $MM->pasthru(), $pastru, 'pasthru()' );
a9200272 290}
291
292package FakeOut;
293
294sub TIEHANDLE {
295 bless(\(my $scalar), $_[0]);
296}
297
298sub PRINT {
299 my $self = shift;
300 $$self .= shift;
301}
302
303__END__
304
305=head1 NAME
306
307MM_Win32.t - Tests for ExtUtils::MM_Win32
308
309=head1 TODO
310
311 - Methods to still be checked:
312 # static_lib() should look into that
313 # dynamic_bs() should look into that
314 # dynamic_lib() should look into that
315 # xs_o() should look into that
316 # top_targets() should look into that
317 # dist_ci() should look into that
318 # dist_core() should look into that
319
320=head1 AUTHOR
321
32220011228 Abe Timmerman <abe@ztreet.demon.nl>
323
324=cut