This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix failing ExtUtils-CBuilder test
[perl5.git] / cpan / ExtUtils-CBuilder / t / 04-base.t
CommitLineData
06e8058f
CBW
1#! perl -w
2
3use strict;
4use Test::More tests => 58;
5BEGIN {
6 if ($^O eq 'VMS') {
7 # So we can get the return value of system()
8 require vmsish;
9 import vmsish;
10 }
11}
12use Config;
13use Cwd;
14use File::Path qw( mkpath );
15use File::Temp qw( tempdir );
16use ExtUtils::CBuilder::Base;
17
18# XXX protect from user CC as we mock everything here
19local $ENV{CC};
20
21my ( $base, $phony, $cwd );
22my ( $source_file, $object_file, $lib_file );
23
24$base = ExtUtils::CBuilder::Base->new();
25ok( $base, "ExtUtils::CBuilder::Base->new() returned true value" );
26isa_ok( $base, 'ExtUtils::CBuilder::Base' );
27
28{
29 $phony = 'foobar';
30 $base = ExtUtils::CBuilder::Base->new(
31 config => { cc => $phony },
32 );
33 ok( $base, "ExtUtils::CBuilder::Base->new() returned true value" );
34 isa_ok( $base, 'ExtUtils::CBuilder::Base' );
35 is( $base->{config}->{cc}, $phony,
36 "Got expected value when 'config' argument passed to new()" );
37}
38
39{
40 $phony = 'barbaz';
41 local $ENV{CC} = $phony;
42 $base = ExtUtils::CBuilder::Base->new();
43 ok( $base, "ExtUtils::CBuilder::Base->new() returned true value" );
44 isa_ok( $base, 'ExtUtils::CBuilder::Base' );
45 is( $base->{config}->{cc}, $phony,
46 "Got expected value \$ENV{CC} set" );
47}
48
49{
50 my $path_to_perl = File::Spec->catfile( '', qw| usr bin perl | );
51 local $^X = $path_to_perl;
52 is(
53 ExtUtils::CBuilder::Base::find_perl_interpreter(),
54 $path_to_perl,
55 "find_perl_interpreter() returned expected absolute path"
56 );
57}
58
59{
60 my $path_to_perl = 'foobar';
61 local $^X = $path_to_perl;
62 # %Config is read-only. We cannot assign to it and we therefore cannot
63 # simulate the condition that would occur were its value something other
64 # than an existing file.
65 if ( !$ENV{PERL_CORE} and $Config::Config{perlpath}) {
66 is(
67 ExtUtils::CBuilder::Base::find_perl_interpreter(),
68 $Config::Config{perlpath},
69 "find_perl_interpreter() returned expected file"
70 );
71 }
72 else {
d8330edc 73 local $^X = $path_to_perl = File::Spec->rel2abs($path_to_perl);
06e8058f
CBW
74 is(
75 ExtUtils::CBuilder::Base::find_perl_interpreter(),
76 $path_to_perl,
77 "find_perl_interpreter() returned expected name"
78 );
79 }
80}
81
82{
83 $cwd = cwd();
84 my $tdir = tempdir();
85 chdir $tdir;
86 $base = ExtUtils::CBuilder::Base->new();
87 ok( $base, "ExtUtils::CBuilder::Base->new() returned true value" );
88 isa_ok( $base, 'ExtUtils::CBuilder::Base' );
89 is( scalar keys %{$base->{files_to_clean}}, 0,
90 "No files needing cleaning yet" );
91
92 my $file_for_cleaning = File::Spec->catfile( $tdir, 'foobar' );
93 open my $IN, '>', $file_for_cleaning
94 or die "Unable to open dummy file: $!";
95 print $IN "\n";
96 close $IN or die "Unable to close dummy file: $!";
97
98 $base->add_to_cleanup( $file_for_cleaning );
99 is( scalar keys %{$base->{files_to_clean}}, 1,
100 "One file needs cleaning" );
101
102 $base->cleanup();
103 ok( ! -f $file_for_cleaning, "File was cleaned up" );
104
105 chdir $cwd;
106}
107
108# fake compiler is perl and will always succeed
109$base = ExtUtils::CBuilder::Base->new(
110 config => {
111 cc => File::Spec->rel2abs($^X) . " -e1 --",
112 ld => File::Spec->rel2abs($^X) . " -e1 --",
113 }
114);
115ok( $base, "ExtUtils::CBuilder::Base->new() returned true value" );
116isa_ok( $base, 'ExtUtils::CBuilder::Base' );
117eval {
118 $base->compile(foo => 'bar');
119};
120like(
121 $@,
122 qr/Missing 'source' argument to compile/,
123 "Got expected error message when lacking 'source' argument to compile()"
124);
125
126$base = ExtUtils::CBuilder::Base->new( quiet => 1 );
127ok( $base, "ExtUtils::CBuilder::Base->new() returned true value" );
128isa_ok( $base, 'ExtUtils::CBuilder::Base' );
129
130$source_file = File::Spec->catfile('t', 'compilet.c');
131create_c_source_file($source_file);
132ok(-e $source_file, "source file '$source_file' created");
133
134# object filename automatically assigned
135my $obj_ext = $base->{config}{obj_ext};
136is( $base->object_file($source_file),
137 File::Spec->catfile('t', "compilet$obj_ext"),
138 "object_file(): got expected automatically assigned name for object file"
139);
140
141# object filename explicitly assigned
142$object_file = File::Spec->catfile('t', 'my_special_compilet.o' );
143is( $object_file,
144 $base->compile(
145 source => $source_file,
146 object_file => $object_file,
147 ),
148 "compile(): returned object file with specified name"
149);
150
151$lib_file = $base->lib_file($object_file);
152ok( $lib_file, "lib_file() returned true value" );
153
154my ($lib, @temps);
155($lib, @temps) = $base->link(
156 objects => $object_file,
157 module_name => 'compilet',
158);
159$lib =~ tr/"'//d; #"
160is($lib_file, $lib, "lib_file(): got expected value for $lib");
161
162($lib, @temps) = $base->link(
163 objects => [ $object_file ],
164 module_name => 'compilet',
165);
166$lib =~ tr/"'//d; #"
167is($lib_file, $lib, "lib_file(): got expected value for $lib");
168
169($lib, @temps) = $base->link(
170 lib_file => $lib_file,
171 objects => [ $object_file ],
172 module_name => 'compilet',
173);
174$lib =~ tr/"'//d; #"
175is($lib_file, $lib, "lib_file(): got expected value for $lib");
176
177$lib = $base->link(
178 objects => $object_file,
179 module_name => 'compilet',
180);
181$lib =~ tr/"'//d; #"
182is($lib_file, $lib, "lib_file(): got expected value for $lib");
183
184{
185 local $ENV{PERL_CORE} = '' unless $ENV{PERL_CORE};
186 my $include_dir = $base->perl_inc();
187 ok( $include_dir, "perl_inc() returned true value" );
188 ok( -d $include_dir, "perl_inc() returned directory" );
189}
190
191#
192$base = ExtUtils::CBuilder::Base->new( quiet => 1 );
193ok( $base, "ExtUtils::CBuilder::Base->new() returned true value" );
194isa_ok( $base, 'ExtUtils::CBuilder::Base' );
195
196$source_file = File::Spec->catfile('t', 'compilet.c');
197create_c_source_file($source_file);
198ok(-e $source_file, "source file '$source_file' created");
199$object_file = File::Spec->catfile('t', 'my_special_compilet.o' );
200is( $object_file,
201 $base->compile(
202 source => $source_file,
203 object_file => $object_file,
204 defines => { alpha => 'beta', gamma => 'delta' },
205 ),
206 "compile() completed when 'defines' provided; returned object file with specified name"
207);
208
209my $exe_file = $base->exe_file($object_file);
210my $ext = $base->{config}{_exe};
211my $expected = File::Spec->catfile('t', qq|my_special_compilet$ext| );
212is(
213 $exe_file,
214 $expected,
215 "exe_file(): returned expected name of executable"
216);
217
218my %args = ();
219my @defines = $base->arg_defines( %args );
220ok( ! @defines, "Empty hash passed to arg_defines() returns empty list" );
221
222%args = ( alpha => 'beta', gamma => 'delta' );
223my $defines_seen_ref = { map { $_ => 1 } $base->arg_defines( %args ) };
224is_deeply(
225 $defines_seen_ref,
226 { '-Dalpha=beta' => 1, '-Dgamma=delta' => 1 },
227 "arg_defines(): got expected defines",
228);
229
230my $include_dirs_seen_ref =
231 { map {$_ => 1} $base->arg_include_dirs( qw| alpha beta gamma | ) };
232is_deeply(
233 $include_dirs_seen_ref,
234 { '-Ialpha' => 1, '-Ibeta' => 1, '-Igamma' => 1 },
235 "arg_include_dirs(): got expected include_dirs",
236);
237
238is( '-c', $base->arg_nolink(), "arg_nolink(): got expected value" );
239
240my $seen_ref =
241 { map {$_ => 1} $base->arg_object_file('alpha') };
242is_deeply(
243 $seen_ref,
244 { '-o' => 1, 'alpha' => 1 },
245 "arg_object_file(): got expected option flag and value",
246);
247
248$seen_ref = { map {$_ => 1} $base->arg_share_object_file('alpha') };
249my %exp = map {$_ => 1} $base->split_like_shell($base->{config}{lddlflags});
250$exp{'-o'} = 1;
251$exp{'alpha'} = 1;
252
253is_deeply(
254 $seen_ref,
255 \%exp,
256 "arg_share_object_file(): got expected option flag and value",
257);
258
259$seen_ref =
260 { map {$_ => 1} $base->arg_exec_file('alpha') };
261is_deeply(
262 $seen_ref,
263 { '-o' => 1, 'alpha' => 1 },
264 "arg_exec_file(): got expected option flag and value",
265);
266
267ok(! $base->split_like_shell(undef),
268 "split_like_shell(): handled undefined argument as expected" );
269
270my $array_ref = [ qw| alpha beta gamma | ];
271my %split_seen = map { $_ => 1 } $base->split_like_shell($array_ref);
272%exp = ( alpha => 1, beta => 1, gamma => 1 );
273is_deeply( \%split_seen, \%exp,
274 "split_like_shell(): handled array ref as expected" );
275
276{
277 $cwd = cwd();
278 my $tdir = tempdir();
279 my $subdir = File::Spec->catdir(
280 $tdir, qw| alpha beta gamma delta epsilon
281 zeta eta theta iota kappa lambda |
282 );
283 mkpath($subdir, { mode => 0711 } );
284 chdir $subdir
285 or die "Unable to change to temporary directory for testing";
286 local $ENV{PERL_CORE} = 1;
287 my $capture = q{};
288 local $SIG{__WARN__} = sub { $capture = $_[0] };
289 my $expected_message =
290 qr/PERL_CORE is set but I can't find your perl source!/; #'
291 my $rv;
292
293 $rv = $base->perl_src();
294 is( $rv, q{}, "perl_src(): returned empty string as expected" );
295 like( $capture, $expected_message,
296 "perl_src(): got expected warning" );
297 $capture = q{};
298
299 my $config = File::Spec->catfile( $subdir, 'config_h.SH' );
300 touch_file($config);
301 $rv = $base->perl_src();
302 is( $rv, q{}, "perl_src(): returned empty string as expected" );
303 like( $capture, $expected_message,
304 "perl_src(): got expected warning" );
305 $capture = q{};
306
307 my $perlh = File::Spec->catfile( $subdir, 'perl.h' );
308 touch_file($perlh);
309 $rv = $base->perl_src();
310 is( $rv, q{}, "perl_src(): returned empty string as expected" );
311 like( $capture, $expected_message,
312 "perl_src(): got expected warning" );
313 $capture = q{};
314
315 my $libsubdir = File::Spec->catdir( $subdir, 'lib' );
316 mkpath($libsubdir, { mode => 0711 } );
317 my $exporter = File::Spec->catfile( $libsubdir, 'Exporter.pm' );
318 touch_file($exporter);
319 $rv = $base->perl_src();
320 ok( -d $rv, "perl_src(): returned a directory" );
321 is( $rv, Cwd::realpath($subdir), "perl_src(): identified directory" );
322 is( $capture, q{}, "perl_src(): no warning, as expected" );
323
324 chdir $cwd
325 or die "Unable to change from temporary directory after testing";
326}
327
328my ($dl_file_out, $mksymlists_args);
329my $dlf = 'Kappa';
330%args = (
331 dl_vars => [ qw| alpha beta gamma | ],
332 dl_funcs => {
333 'Homer::Iliad' => [ qw(trojans greeks) ],
334 'Homer::Odyssey' => [ qw(travellers family suitors) ],
335 },
336 dl_func_list => [ qw| delta epsilon | ],
337 dl_imports => { zeta => 'eta', theta => 'iota' },
338 dl_name => 'Tk::Canvas',
339 dl_base => 'Tk::Canvas.ext',
340 dl_file => $dlf,
341 dl_version => '7.7',
342);
343($dl_file_out, $mksymlists_args) =
344 ExtUtils::CBuilder::Base::_prepare_mksymlists_args(\%args);
345is( $dl_file_out, $dlf, "_prepare_mksymlists_args(): Got expected name for dl_file" );
346is_deeply( $mksymlists_args,
347 {
348 DL_VARS => [ qw| alpha beta gamma | ],
349 DL_FUNCS => {
350 'Homer::Iliad' => [ qw(trojans greeks) ],
351 'Homer::Odyssey' => [ qw(travellers family suitors) ],
352 },
353 FUNCLIST => [ qw| delta epsilon | ],
354 IMPORTS => { zeta => 'eta', theta => 'iota' },
355 NAME => 'Tk::Canvas',
356 DLBASE => 'Tk::Canvas.ext',
357 FILE => $dlf,
358 VERSION => '7.7',
359 },
360 "_prepare_mksymlists_args(): got expected arguments for Mksymlists",
361);
362
363$dlf = 'Canvas';
364%args = (
365 dl_name => 'Tk::Canvas',
366 dl_base => 'Tk::Canvas.ext',
367);
368($dl_file_out, $mksymlists_args) =
369 ExtUtils::CBuilder::Base::_prepare_mksymlists_args(\%args);
370is( $dl_file_out, $dlf, "_prepare_mksymlists_args(): got expected name for dl_file" );
371is_deeply( $mksymlists_args,
372 {
373 DL_VARS => [],
374 DL_FUNCS => {},
375 FUNCLIST => [],
376 IMPORTS => {},
377 NAME => 'Tk::Canvas',
378 DLBASE => 'Tk::Canvas.ext',
379 FILE => $dlf,
380 VERSION => '0.0',
381 },
382 "_prepare_mksymlists_args(): got expected arguments for Mksymlists",
383);
384
385#####
386
387for ($source_file, $object_file, $lib_file) {
388 tr/"'//d; #"
389 1 while unlink;
390}
391
392pass("Completed all tests in $0");
393
394if ($^O eq 'VMS') {
395 1 while unlink 'COMPILET.LIS';
396 1 while unlink 'COMPILET.OPT';
397}
398
399sub create_c_source_file {
400 my $source_file = shift;
401 open my $FH, '>', $source_file or die "Can't create $source_file: $!";
402 print $FH "int boot_compilet(void) { return 1; }\n";
403 close $FH;
404}
405
406sub touch_file {
407 my $f = shift;
408 open my $FH, '>', $f or die "Can't create $f: $!";
409 print $FH "\n";
410 close $FH;
411 return $f;
412}