summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm
blob: b81384f629b92cf75d35e11b4be0123fc0ebdf91 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
package ExtUtils::CBuilder::Platform::Windows;
use strict;
use warnings;

use File::Basename;
use File::Spec;

use ExtUtils::CBuilder::Base;
use IO::File;

our $VERSION = '0.280236'; # VERSION
our @ISA = qw(ExtUtils::CBuilder::Base);

=begin comment

The compiler-specific packages implement functions for generating properly
formatted commandlines for the compiler being used. Each package
defines two primary functions 'format_linker_cmd()' &
'format_compiler_cmd()' that accepts a list of named arguments (a
hash) and returns a list of formatted options suitable for invoking the
compiler. By default, if the compiler supports scripting of its
operation then a script file is built containing the options while
those options are removed from the commandline, and a reference to the
script is pushed onto the commandline in their place. Scripting the
compiler in this way helps to avoid the problems associated with long
commandlines under some shells.

=end comment

=cut

sub new {
  my $class = shift;
  my $self = $class->SUPER::new(@_);
  my $cf = $self->{config};

  # Inherit from an appropriate compiler driver class
  my $driver = "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
  eval "require $driver" or die "Could not load compiler driver: $@";
  unshift @ISA, $driver;

  return $self;
}

sub _compiler_type {
  my $self = shift;
  my $cc = $self->{config}{cc};

  return (  $cc =~ /cl(\.exe)?$/ ? 'MSVC'
	  : $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
	  : 'GCC');
}

sub split_like_shell {
  # Since Windows will pass the whole command string (not an argument
  # array) to the target program and make the program parse it itself,
  # we don't actually need to do any processing here.
  (my $self, local $_) = @_;

  return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
  return unless defined() && length();
  return ($_);
}

sub do_system {
  # See above
  my $self = shift;
  my $cmd = join(" ",
		 grep length,
		 map {$a=$_;$a=~s/\t/ /g;$a=~s/^\s+|\s+$//;$a}
		 grep defined, @_);
  return $self->SUPER::do_system($cmd);
}

sub arg_defines {
  my ($self, %args) = @_;
  s/"/\\"/g foreach values %args;
  return map qq{"-D$_=$args{$_}"}, sort keys %args;
}

sub compile {
  my ($self, %args) = @_;
  my $cf = $self->{config};

  die "Missing 'source' argument to compile()" unless defined $args{source};

  $args{include_dirs} = [ $args{include_dirs} ]
    if exists($args{include_dirs}) && ref($args{include_dirs}) ne "ARRAY";

  my ($basename, $srcdir) =
    ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];

  $srcdir ||= File::Spec->curdir();

  my @defines = $self->arg_defines( %{ $args{defines} || {} } );

  my %spec = (
    srcdir      => $srcdir,
    builddir    => $srcdir,
    basename    => $basename,
    source      => $args{source},
    output      => $args{object_file} || File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
    cc          => $cf->{cc},
    cflags      => [
                     $self->split_like_shell($cf->{ccflags}),
                     $self->split_like_shell($cf->{cccdlflags}),
                     $self->split_like_shell($args{extra_compiler_flags}),
                   ],
    optimize    => [ $self->split_like_shell($cf->{optimize})    ],
    defines     => \@defines,
    includes    => [ @{$args{include_dirs} || []} ],
    perlinc     => [
                     $self->perl_inc(),
                     $self->split_like_shell($cf->{incpath}),
                   ],
    use_scripts => 1, # XXX provide user option to change this???
  );

  $self->normalize_filespecs(
    \$spec{source},
    \$spec{output},
     $spec{includes},
     $spec{perlinc},
  );

  my @cmds = $self->format_compiler_cmd(%spec);
  while ( my $cmd = shift @cmds ) {
    $self->do_system( @$cmd )
      or die "error building $cf->{dlext} file from '$args{source}'";
  }

  (my $out = $spec{output}) =~ tr/'"//d;
  return $out;
}

sub need_prelink { 1 }

sub link {
  my ($self, %args) = @_;
  my $cf = $self->{config};

  my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
  my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
  $to ||= File::Spec->curdir();

  (my $file_base = $args{module_name}) =~ s/.*:://;
  my $output = $args{lib_file} ||
    File::Spec->catfile($to, "$file_base.$cf->{dlext}");

  # if running in perl source tree, look for libs there, not installed
  my $lddlflags = $cf->{lddlflags};
  my $perl_src = $self->perl_src();
  $lddlflags =~ s{\Q$cf->{archlibexp}\E[\\/]CORE}{$perl_src/lib/CORE} if $perl_src;

  my %spec = (
    srcdir        => $to,
    builddir      => $to,
    startup       => [ ],
    objects       => \@objects,
    libs          => [ ],
    output        => $output,
    ld            => $cf->{ld},
    libperl       => $cf->{libperl},
    perllibs      => [ $self->split_like_shell($cf->{perllibs})  ],
    libpath       => [ $self->split_like_shell($cf->{libpth})    ],
    lddlflags     => [ $self->split_like_shell($lddlflags) ],
    other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ],
    use_scripts   => 1, # XXX provide user option to change this???
  );

  unless ( $spec{basename} ) {
    ($spec{basename} = $args{module_name}) =~ s/.*:://;
  }

  $spec{srcdir}   = File::Spec->canonpath( $spec{srcdir}   );
  $spec{builddir} = File::Spec->canonpath( $spec{builddir} );

  $spec{output}    ||= File::Spec->catfile( $spec{builddir},
                                            $spec{basename}  . '.'.$cf->{dlext}   );
  $spec{manifest}  ||= $spec{output} . '.manifest';
  $spec{implib}    ||= File::Spec->catfile( $spec{builddir},
                                            $spec{basename}  . $cf->{lib_ext} );
  $spec{explib}    ||= File::Spec->catfile( $spec{builddir},
                                            $spec{basename}  . '.exp'  );
  if ($cf->{cc} eq 'cl') {
    $spec{dbg_file}  ||= File::Spec->catfile( $spec{builddir},
                                            $spec{basename}  . '.pdb'  );
  }
  elsif ($cf->{cc} eq 'bcc32') {
    $spec{dbg_file}  ||= File::Spec->catfile( $spec{builddir},
                                            $spec{basename}  . '.tds'  );
  }
  $spec{def_file}  ||= File::Spec->catfile( $spec{srcdir}  ,
                                            $spec{basename}  . '.def'  );
  $spec{base_file} ||= File::Spec->catfile( $spec{srcdir}  ,
                                            $spec{basename}  . '.base' );

  $self->add_to_cleanup(
    grep defined,
    @{[ @spec{qw(manifest implib explib dbg_file def_file base_file map_file)} ]}
  );

  foreach my $opt ( qw(output manifest implib explib dbg_file def_file map_file base_file) ) {
    $self->normalize_filespecs( \$spec{$opt} );
  }

  foreach my $opt ( qw(libpath startup objects) ) {
    $self->normalize_filespecs( $spec{$opt} );
  }

  (my $def_base = $spec{def_file}) =~ tr/'"//d;
  $def_base =~ s/\.def$//;
  $self->prelink( %args,
                  dl_name => $args{module_name},
                  dl_file => $def_base,
                  dl_base => $spec{basename} );

  my @cmds = $self->format_linker_cmd(%spec);
  while ( my $cmd = shift @cmds ) {
    $self->do_system( @$cmd );
  }

  $spec{output} =~ tr/'"//d;
  return wantarray
    ? grep defined, @spec{qw[output manifest implib explib dbg_file def_file map_file base_file]}
    : $spec{output};
}

# canonize & quote paths
sub normalize_filespecs {
  my ($self, @specs) = @_;
  foreach my $spec ( grep defined, @specs ) {
    if ( ref $spec eq 'ARRAY') {
      $self->normalize_filespecs( map {\$_} grep defined, @$spec )
    } elsif ( ref $spec eq 'SCALAR' ) {
      $$spec =~ tr/"//d if $$spec;
      next unless $$spec;
      $$spec = '"' . File::Spec->canonpath($$spec) . '"';
    } elsif ( ref $spec eq '' ) {
      $spec = '"' . File::Spec->canonpath($spec) . '"';
    } else {
      die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
    }
  }
}

# directory of perl's include files
sub perl_inc {
  my $self = shift;

  my $perl_src = $self->perl_src();

  if ($perl_src) {
    File::Spec->catdir($perl_src, "lib", "CORE");
  } else {
    File::Spec->catdir($self->{config}{archlibexp},"CORE");
  }
}

1;

__END__

=head1 NAME

ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms

=head1 DESCRIPTION

This module implements the Windows-specific parts of ExtUtils::CBuilder.
Most of the Windows-specific stuff has to do with compiling and
linking C code.  Currently we support the 3 compilers perl itself
supports: MSVC, BCC, and GCC.

This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
not implemented here will be implemented there.  The interfaces are
defined by the L<ExtUtils::CBuilder> documentation.

=head1 AUTHOR

Ken Williams <ken@mathforum.org>

Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.

=head1 SEE ALSO

perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)

=cut