1#!/usr/bin/perl -w
2
3BEGIN {
4    unshift @INC, 't/lib';
5}
6chdir 't';
7
8use strict;
9use Test::More;
10if ($^O =~ /os2/i) {
11	plan( tests => 32 );
12} else {
13	plan( skip_all => "This is not OS/2" );
14}
15
16# for dlsyms, overridden in tests
17BEGIN {
18	package ExtUtils::MM_OS2;
19	use subs 'system', 'unlink';
20}
21
22# for maybe_command
23use File::Spec;
24
25use_ok( 'ExtUtils::MM_OS2' );
26ok( grep( 'ExtUtils::MM_OS2',  @MM::ISA),
27	'ExtUtils::MM_OS2 should be parent of MM' );
28
29# dlsyms
30my $mm = bless({
31	SKIPHASH => {
32		dynamic => 1
33	},
34	NAME => 'foo:bar::',
35}, 'ExtUtils::MM_OS2');
36
37is( $mm->dlsyms(), '',
38	'dlsyms() should return nothing with dynamic flag set' );
39
40$mm->{BASEEXT} = 'baseext';
41delete $mm->{SKIPHASH};
42my $res = $mm->dlsyms();
43like( $res, qr/baseext\.def: Makefile/,
44	'... without flag, should return make targets' );
45like( $res, qr/"DL_FUNCS" => \{  \}/,
46	'... should provide empty hash refs where necessary' );
47like( $res, qr/"DL_VARS" => \[]/, '... and empty array refs too' );
48
49$mm->{FUNCLIST} = 'funclist';
50$res = $mm->dlsyms( IMPORTS => 'imports' );
51like( $res, qr/"FUNCLIST" => .+funclist/,
52	'... should pick up values from object' );
53like( $res, qr/"IMPORTS" => .+imports/, '... and allow parameter options too' );
54
55my $can_write;
56{
57	local *OUT;
58	$can_write = open(OUT, '>tmp_imp');
59}
60
61SKIP: {
62	skip("Cannot write test files: $!", 7) unless $can_write;
63
64	$mm->{IMPORTS} = { foo => 'bar' };
65
66	local $@;
67	eval { $mm->dlsyms() };
68	like( $@, qr/Can.t mkdir tmp_imp/,
69		'... should die if directory cannot be made' );
70
71	unlink('tmp_imp') or skip("Cannot remove test file: $!", 9);
72	eval { $mm->dlsyms() };
73	like( $@, qr/Malformed IMPORT/, 'should die from malformed import symbols');
74
75	$mm->{IMPORTS} = { foo => 'bar.baz' };
76
77	my @sysfail = ( 1, 0, 1 );
78	my ($sysargs, $unlinked);
79
80	*ExtUtils::MM_OS2::system = sub {
81		$sysargs = shift;
82		return shift @sysfail;
83	};
84
85	*ExtUtils::MM_OS2::unlink = sub {
86		$unlinked++;
87	};
88
89	eval { $mm->dlsyms() };
90
91	like( $sysargs, qr/^emximp/, '... should try to call system() though' );
92	like( $@, qr/Cannot make import library/,
93		'... should die if emximp syscall fails' );
94
95	# sysfail is 0 now, call emximp call should succeed
96	eval { $mm->dlsyms() };
97	is( $unlinked, 1, '... should attempt to unlink temp files' );
98	like( $@, qr/Cannot extract import/,
99		'... should die if other syscall fails' );
100
101	# make both syscalls succeed
102	@sysfail = (0, 0);
103	local $@;
104	eval { $mm->dlsyms() };
105	is( $@, '', '... should not die if both syscalls succeed' );
106}
107
108# static_lib
109{
110	my $called = 0;
111
112	# avoid "used only once"
113	local *ExtUtils::MM_Unix::static_lib;
114	*ExtUtils::MM_Unix::static_lib = sub {
115		$called++;
116		return "\n\ncalled static_lib\n\nline2\nline3\n\nline4";
117	};
118
119	my $args = bless({ IMPORTS => {}, }, 'MM');
120
121	# without IMPORTS as a populated hash, there will be no extra data
122	my $ret = ExtUtils::MM_OS2::static_lib( $args );
123	is( $called, 1, 'static_lib() should call parent method' );
124	like( $ret, qr/^called static_lib/m,
125		'... should return parent data unless IMPORTS exists' );
126
127	$args->{IMPORTS} = { foo => 1};
128	$ret = ExtUtils::MM_OS2::static_lib( $args );
129	is( $called, 2, '... should call parent method if extra imports passed' );
130	like( $ret, qr/^called static_lib\n\t\$\(AR\) \$\(AR_STATIC_ARGS\)/m,
131		'... should append make tags to first line from parent method' );
132	like( $ret, qr/\$@\n\n\nline2\nline3\n\nline4/m,
133		'... should include remaining data from parent method' );
134
135}
136
137# replace_manpage_separator
138my $sep = '//a///b//c/de';
139is( ExtUtils::MM_OS2->replace_manpage_separator($sep), '.a.b.c.de',
140	'replace_manpage_separator() should turn multiple slashes into periods' );
141
142# maybe_command
143{
144	local *DIR;
145	my ($dir, $noext, $exe, $cmd);
146	my $found = 0;
147
148	my ($curdir, $updir) = (File::Spec->curdir, File::Spec->updir);
149
150	# we need:
151	#	1) a directory
152	#	2) an executable file with no extension
153	# 	3) an executable file with the .exe extension
154	# 	4) an executable file with the .cmd extension
155	# we assume there will be one somewhere in the path
156	# in addition, we need them to be unique enough they do not trip
157	# an earlier file test in maybe_command().  Portability.
158
159	foreach my $path (split(/:/, $ENV{PATH})) {
160		opendir(DIR, $path) or next;
161		while (defined(my $file = readdir(DIR))) {
162			next if $file eq $curdir or $file eq $updir;
163			$file = File::Spec->catfile($path, $file);
164			unless (defined $dir) {
165				if (-d $file) {
166					next if ( -x $file . '.exe' or -x $file . '.cmd' );
167
168					$dir = $file;
169					$found++;
170				}
171			}
172			if (-x $file) {
173				my $ext;
174				if ($file =~ s/\.(exe|cmd)\z//) {
175					$ext = $1;
176
177					# skip executable files with names too similar
178					next if -x $file;
179					$file .= '.' . $ext;
180
181				} else {
182					unless (defined $noext) {
183						$noext = $file;
184						$found++;
185					}
186					next;
187				}
188
189				unless (defined $exe) {
190					if ($ext eq 'exe') {
191						$exe = $file;
192						$found++;
193						next;
194					}
195				}
196				unless (defined $cmd) {
197					if ($ext eq 'cmd') {
198						$cmd = $file;
199						$found++;
200						next;
201					}
202				}
203			}
204			last if $found == 4;
205		}
206		last if $found == 4;
207	}
208
209	SKIP: {
210		skip('No appropriate directory found', 1) unless defined $dir;
211		is( ExtUtils::MM_OS2->maybe_command( $dir ), undef,
212			'maybe_command() should ignore directories' );
213	}
214
215	SKIP: {
216		skip('No non-exension command found', 1) unless defined $noext;
217		is( ExtUtils::MM_OS2->maybe_command( $noext ), $noext,
218			'maybe_command() should find executable lacking file extension' );
219	}
220
221	SKIP: {
222		skip('No .exe command found', 1) unless defined $exe;
223		(my $noexe = $exe) =~ s/\.exe\z//;
224		is( ExtUtils::MM_OS2->maybe_command( $noexe ), $exe,
225			'maybe_command() should find .exe file lacking extension' );
226	}
227
228	SKIP: {
229		skip('No .cmd command found', 1) unless defined $cmd;
230		(my $nocmd = $cmd) =~ s/\.cmd\z//;
231		is( ExtUtils::MM_OS2->maybe_command( $nocmd ), $cmd,
232			'maybe_command() should find .cmd file lacking extension' );
233	}
234}
235
236# file_name_is_absolute
237ok( ExtUtils::MM_OS2->file_name_is_absolute( 's:/' ),
238	'file_name_is_absolute() should be true for paths with volume and slash' );
239ok( ExtUtils::MM_OS2->file_name_is_absolute( '\foo' ),
240	'... and for paths with leading slash but no volume' );
241ok( ! ExtUtils::MM_OS2->file_name_is_absolute( 'arduk' ),
242	'... but not for paths with no leading slash or volume' );
243
244
245$mm->init_linker;
246
247# PERL_ARCHIVE
248is( $mm->{PERL_ARCHIVE}, '$(PERL_INC)/libperl$(LIB_EXT)', 'PERL_ARCHIVE' );
249
250# PERL_ARCHIVE_AFTER
251{
252	my $aout = 0;
253	local *OS2::is_aout;
254	*OS2::is_aout = \$aout;
255
256        $mm->init_linker;
257	isnt( $mm->{PERL_ARCHIVE_AFTER}, '',
258		'PERL_ARCHIVE_AFTER should be empty without $is_aout set' );
259	$aout = 1;
260	is( $mm->{PERL_ARCHIVE_AFTER},
261            '$(PERL_INC)/libperl_override$(LIB_EXT)',
262		'... and has libperl_override if it is set' );
263}
264
265# EXPORT_LIST
266is( $mm->{EXPORT_LIST}, '$(BASEEXT).def',
267	'EXPORT_LIST should add .def to BASEEXT member' );
268
269END {
270	use File::Path;
271	rmtree('tmp_imp') if -e 'tmp_imp';
272	unlink 'tmpimp.imp';
273}
274