This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: $^CHILD_ERROR_NATIVE issues (with attachment)
[perl5.git] / lib / ExtUtils / CBuilder / Platform / Windows.pm
CommitLineData
6b09c160
YST
1package ExtUtils::CBuilder::Platform::Windows;
2
3use strict;
4use warnings;
5
6use File::Basename;
7use File::Spec;
8
9use ExtUtils::CBuilder::Base;
10
11use vars qw($VERSION @ISA);
345dbb93 12$VERSION = '0.12';
6b09c160
YST
13@ISA = qw(ExtUtils::CBuilder::Base);
14
15sub new {
16 my $class = shift;
17 my $self = $class->SUPER::new(@_);
18 my $cf = $self->{config};
19
20 # Inherit from an appropriate compiler driver class
21 unshift @ISA, "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
22
23 return $self;
24}
25
26sub _compiler_type {
27 my $self = shift;
28 my $cc = $self->{config}{cc};
29
30 return ( $cc =~ /cl(\.exe)?$/ ? 'MSVC'
31 : $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
32 : 'GCC');
33}
34
35sub split_like_shell {
36 # As it turns out, Windows command-parsing is very different from
37 # Unix command-parsing. Double-quotes mean different things,
38 # backslashes don't necessarily mean escapes, and so on. So we
39 # can't use Text::ParseWords::shellwords() to break a command string
40 # into words. The algorithm below was bashed out by Randy and Ken
41 # (mostly Randy), and there are a lot of regression tests, so we
42 # should feel free to adjust if desired.
43
44 (my $self, local $_) = @_;
45
46 return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
47
48 my @argv;
49 return @argv unless defined() && length();
50
51 my $arg = '';
52 my( $i, $quote_mode ) = ( 0, 0 );
53
54 while ( $i < length() ) {
55
56 my $ch = substr( $_, $i , 1 );
57 my $next_ch = substr( $_, $i+1, 1 );
58
59 if ( $ch eq '\\' && $next_ch eq '"' ) {
60 $arg .= '"';
61 $i++;
62 } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
63 $arg .= '\\';
64 $i++;
65 } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
66 $quote_mode = !$quote_mode;
67 $arg .= '"';
68 $i++;
69 } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
70 ( $i + 2 == length() ||
71 substr( $_, $i + 2, 1 ) eq ' ' )
72 ) { # for cases like: a"" => [ 'a' ]
73 push( @argv, $arg );
74 $arg = '';
75 $i += 2;
76 } elsif ( $ch eq '"' ) {
77 $quote_mode = !$quote_mode;
78 } elsif ( $ch eq ' ' && !$quote_mode ) {
79 push( @argv, $arg ) if $arg;
80 $arg = '';
81 ++$i while substr( $_, $i + 1, 1 ) eq ' ';
82 } else {
83 $arg .= $ch;
84 }
85
86 $i++;
87 }
88
89 push( @argv, $arg ) if defined( $arg ) && length( $arg );
90 return @argv;
91}
92
93sub compile {
94 my ($self, %args) = @_;
95 my $cf = $self->{config};
96
97 die "Missing 'source' argument to compile()" unless defined $args{source};
98
99 my ($basename, $srcdir) =
100 ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];
101
102 $srcdir ||= File::Spec->curdir();
103
104 my %spec = (
105 srcdir => $srcdir,
106 builddir => $srcdir,
107 basename => $basename,
108 source => $args{source},
109 output => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
110 cc => $cf->{cc},
111 cflags => [
112 $self->split_like_shell($cf->{ccflags}),
113 $self->split_like_shell($cf->{cccdlflags}),
114 ],
115 optimize => [ $self->split_like_shell($cf->{optimize}) ],
116 defines => [ '' ],
117 includes => [ @{$args{include_dirs} || []} ],
118 perlinc => [
119 $self->perl_inc(),
120 $self->split_like_shell($cf->{incpath}),
121 ],
122 use_scripts => 1, # XXX provide user option to change this???
123 );
124
6b09c160
YST
125 $self->normalize_filespecs(
126 \$spec{source},
127 \$spec{output},
128 $spec{includes},
129 $spec{perlinc},
130 );
131
132 my @cmds = $self->format_compiler_cmd(%spec);
133 while ( my $cmd = shift @cmds ) {
134 $self->do_system( @$cmd )
135 or die "error building $cf->{dlext} file from '$args{source}'";
136 }
137
138 (my $out = $spec{output}) =~ tr/'"//d;
139 return $out;
140}
141
142sub need_prelink { 1 }
143
144sub link {
145 my ($self, %args) = @_;
146 my $cf = $self->{config};
147
148 my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
149 my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
150 $to ||= File::Spec->curdir();
151
152 (my $file_base = $args{module_name}) =~ s/.*:://;
153 my $output = $args{lib_file} ||
154 File::Spec->catfile($to, "$file_base.$cf->{dlext}");
155
156 # if running in perl source tree, look for libs there, not installed
157 my $lddlflags = $cf->{lddlflags};
158 my $perl_src = $self->perl_src();
345dbb93 159 $lddlflags =~ s/\Q$cf->{archlibexp}\E[\\\/]CORE/$perl_src/ if $perl_src;
6b09c160
YST
160
161 my %spec = (
162 srcdir => $to,
163 builddir => $to,
164 startup => [ ],
165 objects => \@objects,
166 libs => [ ],
167 output => $output,
168 ld => $cf->{ld},
169 libperl => $cf->{libperl},
170 perllibs => [ $self->split_like_shell($cf->{perllibs}) ],
171 libpath => [ $self->split_like_shell($cf->{libpth}) ],
172 lddlflags => [ $self->split_like_shell($lddlflags) ],
173 other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ],
174 use_scripts => 1, # XXX provide user option to change this???
175 );
176
177 unless ( $spec{basename} ) {
178 ($spec{basename} = $args{module_name}) =~ s/.*:://;
179 }
180
181 $spec{srcdir} = File::Spec->canonpath( $spec{srcdir} );
182 $spec{builddir} = File::Spec->canonpath( $spec{builddir} );
183
184 $spec{output} ||= File::Spec->catfile( $spec{builddir},
185 $spec{basename} . '.'.$cf->{dlext} );
186 $spec{implib} ||= File::Spec->catfile( $spec{builddir},
187 $spec{basename} . $cf->{lib_ext} );
188 $spec{explib} ||= File::Spec->catfile( $spec{builddir},
189 $spec{basename} . '.exp' );
190 $spec{def_file} ||= File::Spec->catfile( $spec{srcdir} ,
191 $spec{basename} . '.def' );
192 $spec{base_file} ||= File::Spec->catfile( $spec{srcdir} ,
193 $spec{basename} . '.base' );
194
195 $self->add_to_cleanup(
196 grep defined,
5c71b354 197 @{[ @spec{qw(implib explib def_file base_file map_file)} ]}
6b09c160
YST
198 );
199
200 foreach my $opt ( qw(output implib explib def_file map_file base_file) ) {
201 $self->normalize_filespecs( \$spec{$opt} );
202 }
203
204 foreach my $opt ( qw(libpath startup objects) ) {
205 $self->normalize_filespecs( $spec{$opt} );
206 }
207
208 (my $def_base = $spec{def_file}) =~ tr/'"//d;
209 $def_base =~ s/\.def$//;
210 $self->prelink( dl_name => $args{module_name},
211 dl_file => $def_base,
212 dl_base => $spec{basename} );
213
214 my @cmds = $self->format_linker_cmd(%spec);
215 while ( my $cmd = shift @cmds ) {
216 $self->do_system( @$cmd );
217 }
218
219 $spec{output} =~ tr/'"//d;
220 return wantarray
221 ? grep defined, @spec{qw[output implib explib def_file map_file base_file]}
222 : $spec{output};
223}
224
225# canonize & quote paths
226sub normalize_filespecs {
227 my ($self, @specs) = @_;
228 foreach my $spec ( grep defined, @specs ) {
229 if ( ref $spec eq 'ARRAY') {
230 $self->normalize_filespecs( map {\$_} grep defined, @$spec )
231 } elsif ( ref $spec eq 'SCALAR' ) {
232 $$spec =~ tr/"//d if $$spec;
233 next unless $$spec;
234 $$spec = '"' . File::Spec->canonpath($$spec) . '"';
235 } elsif ( ref $spec eq '' ) {
236 $spec = '"' . File::Spec->canonpath($spec) . '"';
237 } else {
238 die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
239 }
240 }
241}
242
243# directory of perl's include files
244sub perl_inc {
245 my $self = shift;
246
247 my $perl_src = $self->perl_src();
248
249 if ($perl_src) {
250 File::Spec->catdir($perl_src, "lib", "CORE");
251 } else {
252 File::Spec->catdir($self->{config}{archlibexp},"CORE");
253 }
254}
255
2561;
257
258########################################################################
259
260=begin comment
261
262The packages below implement functions for generating properly
3c4b39be 263formatted commandlines for the compiler being used. Each package
6b09c160
YST
264defines two primary functions 'format_linker_cmd()' &
265'format_compiler_cmd()' that accepts a list of named arguments (a
3c4b39be 266hash) and returns a list of formatted options suitable for invoking the
6b09c160
YST
267compiler. By default, if the compiler supports scripting of its
268operation then a script file is built containing the options while
269those options are removed from the commandline, and a reference to the
270script is pushed onto the commandline in their place. Scripting the
271compiler in this way helps to avoid the problems associated with long
272commandlines under some shells.
273
274=end comment
275
276=cut
277
278########################################################################
279package ExtUtils::CBuilder::Platform::Windows::MSVC;
280
281sub format_compiler_cmd {
282 my ($self, %spec) = @_;
283
284 foreach my $path ( @{ $spec{includes} || [] },
285 @{ $spec{perlinc} || [] } ) {
286 $path = '-I' . $path;
287 }
288
289 %spec = $self->write_compiler_script(%spec)
290 if $spec{use_scripts};
291
292 return [ grep {defined && length} (
293 $spec{cc},'-nologo','-c',
294 @{$spec{includes}} ,
295 @{$spec{cflags}} ,
296 @{$spec{optimize}} ,
297 @{$spec{defines}} ,
298 @{$spec{perlinc}} ,
299 "-Fo$spec{output}" ,
300 $spec{source} ,
301 ) ];
302}
303
304sub write_compiler_script {
305 my ($self, %spec) = @_;
306
307 my $script = File::Spec->catfile( $spec{srcdir},
308 $spec{basename} . '.ccs' );
309
310 $self->add_to_cleanup($script);
311
312 print "Generating script '$script'\n" if !$self->{quiet};
313
314 open( SCRIPT, ">$script" )
315 or die( "Could not create script '$script': $!" );
316
317 print SCRIPT join( "\n",
318 map { ref $_ ? @{$_} : $_ }
319 grep defined,
320 delete(
321 @spec{ qw(includes cflags optimize defines perlinc) } )
322 );
323
324 close SCRIPT;
325
326 push @{$spec{includes}}, '@"' . $script . '"';
327
328 return %spec;
329}
330
331sub format_linker_cmd {
332 my ($self, %spec) = @_;
333
334 foreach my $path ( @{$spec{libpath}} ) {
335 $path = "-libpath:$path";
336 }
337
338 $spec{def_file} &&= '-def:' . $spec{def_file};
339 $spec{output} &&= '-out:' . $spec{output};
340 $spec{implib} &&= '-implib:' . $spec{implib};
341 $spec{map_file} &&= '-map:' . $spec{map_file};
342
343 %spec = $self->write_linker_script(%spec)
344 if $spec{use_scripts};
345
346 return [ grep {defined && length} (
347 $spec{ld} ,
348 @{$spec{lddlflags}} ,
349 @{$spec{libpath}} ,
350 @{$spec{other_ldflags}} ,
351 @{$spec{startup}} ,
352 @{$spec{objects}} ,
353 $spec{map_file} ,
354 $spec{libperl} ,
355 @{$spec{perllibs}} ,
356 $spec{def_file} ,
357 $spec{implib} ,
358 $spec{output} ,
359 ) ];
360}
361
362sub write_linker_script {
363 my ($self, %spec) = @_;
364
365 my $script = File::Spec->catfile( $spec{srcdir},
366 $spec{basename} . '.lds' );
367
368 $self->add_to_cleanup($script);
369
370 print "Generating script '$script'\n" if !$self->{quiet};
371
372 open( SCRIPT, ">$script" )
373 or die( "Could not create script '$script': $!" );
374
375 print SCRIPT join( "\n",
376 map { ref $_ ? @{$_} : $_ }
377 grep defined,
378 delete(
379 @spec{ qw(lddlflags libpath other_ldflags
380 startup objects libperl perllibs
381 def_file implib map_file) } )
382 );
383
384 close SCRIPT;
385
386 push @{$spec{lddlflags}}, '@"' . $script . '"';
387
388 return %spec;
389}
390
3911;
392
393########################################################################
394package ExtUtils::CBuilder::Platform::Windows::BCC;
395
396sub format_compiler_cmd {
397 my ($self, %spec) = @_;
398
399 foreach my $path ( @{ $spec{includes} || [] },
400 @{ $spec{perlinc} || [] } ) {
401 $path = '-I' . $path;
402 }
403
404 %spec = $self->write_compiler_script(%spec)
405 if $spec{use_scripts};
406
407 return [ grep {defined && length} (
408 $spec{cc}, '-c' ,
409 @{$spec{includes}} ,
410 @{$spec{cflags}} ,
411 @{$spec{optimize}} ,
412 @{$spec{defines}} ,
413 @{$spec{perlinc}} ,
414 "-o$spec{output}" ,
415 $spec{source} ,
416 ) ];
417}
418
419sub write_compiler_script {
420 my ($self, %spec) = @_;
421
422 my $script = File::Spec->catfile( $spec{srcdir},
423 $spec{basename} . '.ccs' );
424
425 $self->add_to_cleanup($script);
426
427 print "Generating script '$script'\n" if !$self->{quiet};
428
429 open( SCRIPT, ">$script" )
430 or die( "Could not create script '$script': $!" );
431
432 print SCRIPT join( "\n",
433 map { ref $_ ? @{$_} : $_ }
434 grep defined,
435 delete(
436 @spec{ qw(includes cflags optimize defines perlinc) } )
437 );
438
439 close SCRIPT;
440
441 push @{$spec{includes}}, '@"' . $script . '"';
442
443 return %spec;
444}
445
446sub format_linker_cmd {
447 my ($self, %spec) = @_;
448
449 foreach my $path ( @{$spec{libpath}} ) {
450 $path = "-L$path";
451 }
452
453 push( @{$spec{startup}}, 'c0d32.obj' )
454 unless ( $spec{starup} && @{$spec{startup}} );
455
456 %spec = $self->write_linker_script(%spec)
457 if $spec{use_scripts};
458
459 return [ grep {defined && length} (
460 $spec{ld} ,
461 @{$spec{lddlflags}} ,
462 @{$spec{libpath}} ,
463 @{$spec{other_ldflags}} ,
464 @{$spec{startup}} ,
465 @{$spec{objects}} , ',',
466 $spec{output} , ',',
467 $spec{map_file} , ',',
468 $spec{libperl} ,
469 @{$spec{perllibs}} , ',',
470 $spec{def_file}
471 ) ];
472}
473
474sub write_linker_script {
475 my ($self, %spec) = @_;
476
477 # To work around Borlands "unique" commandline syntax,
478 # two scripts are used:
479
480 my $ld_script = File::Spec->catfile( $spec{srcdir},
481 $spec{basename} . '.lds' );
482 my $ld_libs = File::Spec->catfile( $spec{srcdir},
483 $spec{basename} . '.lbs' );
484
485 $self->add_to_cleanup($ld_script, $ld_libs);
486
487 print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
488
489 # Script 1: contains options & names of object files.
490 open( LD_SCRIPT, ">$ld_script" )
491 or die( "Could not create linker script '$ld_script': $!" );
492
493 print LD_SCRIPT join( " +\n",
494 map { @{$_} }
495 grep defined,
496 delete(
497 @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
498 );
499
500 close LD_SCRIPT;
501
502 # Script 2: contains name of libs to link against.
503 open( LD_LIBS, ">$ld_libs" )
504 or die( "Could not create linker script '$ld_libs': $!" );
505
506 print LD_LIBS join( " +\n",
507 (delete $spec{libperl} || ''),
508 @{delete $spec{perllibs} || []},
509 );
510
511 close LD_LIBS;
512
513 push @{$spec{lddlflags}}, '@"' . $ld_script . '"';
514 push @{$spec{perllibs}}, '@"' . $ld_libs . '"';
515
516 return %spec;
517}
518
5191;
520
521########################################################################
522package ExtUtils::CBuilder::Platform::Windows::GCC;
523
524sub format_compiler_cmd {
525 my ($self, %spec) = @_;
526
527 foreach my $path ( @{ $spec{includes} || [] },
528 @{ $spec{perlinc} || [] } ) {
529 $path = '-I' . $path;
530 }
531
532 # split off any -arguments included in cc
533 my @cc = split / (?=-)/, $spec{cc};
534
535 return [ grep {defined && length} (
536 @cc, '-c' ,
537 @{$spec{includes}} ,
538 @{$spec{cflags}} ,
539 @{$spec{optimize}} ,
540 @{$spec{defines}} ,
541 @{$spec{perlinc}} ,
542 '-o', $spec{output} ,
543 $spec{source} ,
544 ) ];
545}
546
547sub format_linker_cmd {
548 my ($self, %spec) = @_;
549
550 # The Config.pm variable 'libperl' is hardcoded to the full name
551 # of the perl import library (i.e. 'libperl56.a'). GCC will not
552 # find it unless the 'lib' prefix & the extension are stripped.
553 $spec{libperl} =~ s/^(?:lib)?([^.]+).*$/-l$1/;
554
555 unshift( @{$spec{other_ldflags}}, '-nostartfiles' )
556 if ( $spec{startup} && @{$spec{startup}} );
557
558 # From ExtUtils::MM_Win32:
559 #
560 ## one thing for GCC/Mingw32:
561 ## we try to overcome non-relocateable-DLL problems by generating
562 ## a (hopefully unique) image-base from the dll's name
563 ## -- BKS, 10-19-1999
564 File::Basename::basename( $spec{output} ) =~ /(....)(.{0,4})/;
565 $spec{image_base} = sprintf( "0x%x0000", unpack('n', $1 ^ $2) );
566
567 %spec = $self->write_linker_script(%spec)
568 if $spec{use_scripts};
569
570 foreach my $path ( @{$spec{libpath}} ) {
571 $path = "-L$path";
572 }
573
574 my @cmds; # Stores the series of commands needed to build the module.
575
576 push @cmds, [
577 'dlltool', '--def' , $spec{def_file},
578 '--output-exp' , $spec{explib}
579 ];
580
581 # split off any -arguments included in ld
582 my @ld = split / (?=-)/, $spec{ld};
583
584 push @cmds, [ grep {defined && length} (
585 @ld ,
586 '-o', $spec{output} ,
587 "-Wl,--base-file,$spec{base_file}" ,
588 "-Wl,--image-base,$spec{image_base}" ,
589 @{$spec{lddlflags}} ,
590 @{$spec{libpath}} ,
591 @{$spec{startup}} ,
592 @{$spec{objects}} ,
593 @{$spec{other_ldflags}} ,
594 $spec{libperl} ,
595 @{$spec{perllibs}} ,
596 $spec{explib} ,
597 $spec{map_file} ? ('-Map', $spec{map_file}) : ''
598 ) ];
599
600 push @cmds, [
601 'dlltool', '--def' , $spec{def_file},
602 '--output-exp' , $spec{explib},
603 '--base-file' , $spec{base_file}
604 ];
605
606 push @cmds, [ grep {defined && length} (
607 @ld ,
608 '-o', $spec{output} ,
609 "-Wl,--image-base,$spec{image_base}" ,
610 @{$spec{lddlflags}} ,
611 @{$spec{libpath}} ,
612 @{$spec{startup}} ,
613 @{$spec{objects}} ,
614 @{$spec{other_ldflags}} ,
615 $spec{libperl} ,
616 @{$spec{perllibs}} ,
617 $spec{explib} ,
618 $spec{map_file} ? ('-Map', $spec{map_file}) : ''
619 ) ];
620
621 return @cmds;
622}
623
624sub write_linker_script {
625 my ($self, %spec) = @_;
626
627 my $script = File::Spec->catfile( $spec{srcdir},
628 $spec{basename} . '.lds' );
629
630 $self->add_to_cleanup($script);
631
632 print "Generating script '$script'\n" if !$self->{quiet};
633
634 open( SCRIPT, ">$script" )
635 or die( "Could not create script '$script': $!" );
636
637 print( SCRIPT 'SEARCH_DIR(' . $_ . ")\n" )
638 for @{delete $spec{libpath} || []};
639
640 # gcc takes only one startup file, so the first object in startup is
641 # specified as the startup file and any others are shifted into the
642 # beginning of the list of objects.
643 if ( $spec{startup} && @{$spec{startup}} ) {
644 print SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
645 unshift @{$spec{objects}},
646 @{delete $spec{startup} || []};
647 }
648
649 print SCRIPT 'INPUT(' . join( ',',
650 @{delete $spec{objects} || []}
651 ) . ")\n";
652
653 print SCRIPT 'INPUT(' . join( ' ',
654 (delete $spec{libperl} || ''),
655 @{delete $spec{perllibs} || []},
656 ) . ")\n";
657
658 close SCRIPT;
659
660 push @{$spec{other_ldflags}}, '"' . $script . '"';
661
662 return %spec;
663}
664
6651;
666
667__END__
668
669=head1 NAME
670
671ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
672
673=head1 DESCRIPTION
674
675This module implements the Windows-specific parts of ExtUtils::CBuilder.
676Most of the Windows-specific stuff has to do with compiling and
677linking C code. Currently we support the 3 compilers perl itself
678supports: MSVC, BCC, and GCC.
679
680This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
681not implemented here will be implemented there. The interfaces are
682defined by the L<ExtUtils::CBuilder> documentation.
683
684=head1 AUTHOR
685
686Ken Williams <ken@mathforum.org>
687
688Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
689
690=head1 SEE ALSO
691
692perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)
693
694=cut