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