"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm" (7 Mar 2020, 3503 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 package ExtUtils::CBuilder::Platform::Windows::BCC;
    2 
    3 our $VERSION = '0.280231'; # VERSION
    4 
    5 use strict;
    6 use warnings;
    7 
    8 sub format_compiler_cmd {
    9   my ($self, %spec) = @_;
   10 
   11   foreach my $path ( @{ $spec{includes} || [] },
   12                      @{ $spec{perlinc}  || [] } ) {
   13     $path = '-I' . $path;
   14   }
   15 
   16   %spec = $self->write_compiler_script(%spec)
   17     if $spec{use_scripts};
   18 
   19   return [ grep {defined && length} (
   20     $spec{cc}, '-c'         ,
   21     @{$spec{includes}}      ,
   22     @{$spec{cflags}}        ,
   23     @{$spec{optimize}}      ,
   24     @{$spec{defines}}       ,
   25     @{$spec{perlinc}}       ,
   26     "-o$spec{output}"       ,
   27     $spec{source}           ,
   28   ) ];
   29 }
   30 
   31 sub write_compiler_script {
   32   my ($self, %spec) = @_;
   33 
   34   my $script = File::Spec->catfile( $spec{srcdir},
   35                                     $spec{basename} . '.ccs' );
   36 
   37   $self->add_to_cleanup($script);
   38 
   39   print "Generating script '$script'\n" if !$self->{quiet};
   40 
   41   my $SCRIPT = IO::File->new( ">$script" )
   42     or die( "Could not create script '$script': $!" );
   43 
   44   # XXX Borland "response files" seem to be unable to accept macro
   45   # definitions containing quoted strings. Escaping strings with
   46   # backslash doesn't work, and any level of quotes are stripped. The
   47   # result is a floating point number in the source file where a
   48   # string is expected. So we leave the macros on the command line.
   49   print $SCRIPT join( "\n",
   50     map { ref $_ ? @{$_} : $_ }
   51     grep defined,
   52     delete(
   53       @spec{ qw(includes cflags optimize perlinc) } )
   54   );
   55 
   56   push @{$spec{includes}}, '@"' . $script . '"';
   57 
   58   return %spec;
   59 }
   60 
   61 sub format_linker_cmd {
   62   my ($self, %spec) = @_;
   63 
   64   foreach my $path ( @{$spec{libpath}} ) {
   65     $path = "-L$path";
   66   }
   67 
   68   push( @{$spec{startup}}, 'c0d32.obj' )
   69     unless ( $spec{startup} && @{$spec{startup}} );
   70 
   71   %spec = $self->write_linker_script(%spec)
   72     if $spec{use_scripts};
   73 
   74   return [ grep {defined && length} (
   75     $spec{ld}               ,
   76     @{$spec{lddlflags}}     ,
   77     @{$spec{libpath}}       ,
   78     @{$spec{other_ldflags}} ,
   79     @{$spec{startup}}       ,
   80     @{$spec{objects}}       , ',',
   81     $spec{output}           , ',',
   82     $spec{map_file}         , ',',
   83     $spec{libperl}          ,
   84     @{$spec{perllibs}}      , ',',
   85     $spec{def_file}
   86   ) ];
   87 }
   88 
   89 sub write_linker_script {
   90   my ($self, %spec) = @_;
   91 
   92   # To work around Borlands "unique" commandline syntax,
   93   # two scripts are used:
   94 
   95   my $ld_script = File::Spec->catfile( $spec{srcdir},
   96                                        $spec{basename} . '.lds' );
   97   my $ld_libs   = File::Spec->catfile( $spec{srcdir},
   98                                        $spec{basename} . '.lbs' );
   99 
  100   $self->add_to_cleanup($ld_script, $ld_libs);
  101 
  102   print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
  103 
  104   # Script 1: contains options & names of object files.
  105   my $LD_SCRIPT = IO::File->new( ">$ld_script" )
  106     or die( "Could not create linker script '$ld_script': $!" );
  107 
  108   print $LD_SCRIPT join( " +\n",
  109     map { @{$_} }
  110     grep defined,
  111     delete(
  112       @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
  113   );
  114 
  115   # Script 2: contains name of libs to link against.
  116   my $LD_LIBS = IO::File->new( ">$ld_libs" )
  117     or die( "Could not create linker script '$ld_libs': $!" );
  118 
  119   print $LD_LIBS join( " +\n",
  120      (delete $spec{libperl}  || ''),
  121     @{delete $spec{perllibs} || []},
  122   );
  123 
  124   push @{$spec{lddlflags}}, '@"' . $ld_script  . '"';
  125   push @{$spec{perllibs}},  '@"' . $ld_libs    . '"';
  126 
  127   return %spec;
  128 }
  129 
  130 1;
  131 
  132