Home | History | Annotate | Line # | Download | only in util
add-depends.pl revision 1.1
      1  1.1  christos #! /usr/bin/env perl
      2  1.1  christos # Copyright 2018 The OpenSSL Project Authors. All Rights Reserved.
      3  1.1  christos #
      4  1.1  christos # Licensed under the OpenSSL license (the "License").  You may not use
      5  1.1  christos # this file except in compliance with the License.  You can obtain a copy
      6  1.1  christos # in the file LICENSE in the source distribution or at
      7  1.1  christos # https://www.openssl.org/source/license.html
      8  1.1  christos 
      9  1.1  christos use strict;
     10  1.1  christos use warnings;
     11  1.1  christos 
     12  1.1  christos use lib '.';
     13  1.1  christos use configdata;
     14  1.1  christos 
     15  1.1  christos use File::Spec::Functions qw(:DEFAULT rel2abs);
     16  1.1  christos use File::Compare qw(compare_text);
     17  1.1  christos use feature 'state';
     18  1.1  christos 
     19  1.1  christos # When using stat() on Windows, we can get it to perform better by avoid some
     20  1.1  christos # data.  This doesn't affect the mtime field, so we're not losing anything...
     21  1.1  christos ${^WIN32_SLOPPY_STAT} = 1;
     22  1.1  christos 
     23  1.1  christos my $debug = $ENV{ADD_DEPENDS_DEBUG};
     24  1.1  christos my $buildfile = $config{build_file};
     25  1.1  christos my $build_mtime = (stat($buildfile))[9];
     26  1.1  christos my $rebuild = 0;
     27  1.1  christos my $depext = $target{dep_extension} || ".d";
     28  1.1  christos my @depfiles =
     29  1.1  christos     sort
     30  1.1  christos     grep {
     31  1.1  christos         # This grep has side effects.  Not only does if check the existence
     32  1.1  christos         # of the dependency file given in $_, but it also checks if it's
     33  1.1  christos         # newer than the build file, and if it is, sets $rebuild.
     34  1.1  christos         my @st = stat($_);
     35  1.1  christos         $rebuild = 1 if @st && $st[9] > $build_mtime;
     36  1.1  christos         scalar @st > 0;         # Determines the grep result
     37  1.1  christos     }
     38  1.1  christos     map { (my $x = $_) =~ s|\.o$|$depext|; $x; }
     39  1.1  christos     grep { $unified_info{sources}->{$_}->[0] =~ /\.cc?$/ }
     40  1.1  christos     keys %{$unified_info{sources}};
     41  1.1  christos 
     42  1.1  christos exit 0 unless $rebuild;
     43  1.1  christos 
     44  1.1  christos # Ok, primary checks are done, time to do some real work
     45  1.1  christos 
     46  1.1  christos my $producer = shift @ARGV;
     47  1.1  christos die "Producer not given\n" unless $producer;
     48  1.1  christos 
     49  1.1  christos my $srcdir = $config{sourcedir};
     50  1.1  christos my $blddir = $config{builddir};
     51  1.1  christos my $abs_srcdir = rel2abs($srcdir);
     52  1.1  christos my $abs_blddir = rel2abs($blddir);
     53  1.1  christos 
     54  1.1  christos # Convenient cache of absolute to relative map.  We start with filling it
     55  1.1  christos # with mappings for the known generated header files.  They are relative to
     56  1.1  christos # the current working directory, so that's an easy task.
     57  1.1  christos # NOTE: there's more than C header files that are generated.  They will also
     58  1.1  christos # generate entries in this map.  We could of course deal with C header files
     59  1.1  christos # only, but in case we decide to handle more than just C files in the future,
     60  1.1  christos # we already have the mechanism in place here.
     61  1.1  christos # NOTE2: we lower case the index to make it searchable without regard for
     62  1.1  christos # character case.  That could seem dangerous, but as long as we don't have
     63  1.1  christos # files we depend on in the same directory that only differ by character case,
     64  1.1  christos # we're fine.
     65  1.1  christos my %depconv_cache =
     66  1.1  christos     map { lc catfile($abs_blddir, $_) => $_ }
     67  1.1  christos     keys %{$unified_info{generate}};
     68  1.1  christos 
     69  1.1  christos my %procedures = (
     70  1.1  christos     'gcc' => undef,             # gcc style dependency files needs no mods
     71  1.1  christos     'makedepend' =>
     72  1.1  christos         sub {
     73  1.1  christos             # makedepend, in its infinite wisdom, wants to have the object file
     74  1.1  christos             # in the same directory as the source file.  This doesn't work too
     75  1.1  christos             # well with out-of-source-tree builds, so we must resort to tricks
     76  1.1  christos             # to get things right.  Fortunately, the .d files are always placed
     77  1.1  christos             # parallel with the object files, so all we need to do is construct
     78  1.1  christos             # the object file name from the dep file name.
     79  1.1  christos             (my $objfile = shift) =~ s|\.d$|.o|i;
     80  1.1  christos             my $line = shift;
     81  1.1  christos 
     82  1.1  christos             # Discard comments
     83  1.1  christos             return undef if $line =~ /^(#.*|\s*)$/;
     84  1.1  christos 
     85  1.1  christos             # Remove the original object file
     86  1.1  christos             $line =~ s|^.*\.o: | |;
     87  1.1  christos             # Also, remove any dependency that starts with a /, because those
     88  1.1  christos             # are typically system headers
     89  1.1  christos             $line =~ s/\s+\/(\\.|\S)*//g;
     90  1.1  christos             # Finally, discard all empty lines
     91  1.1  christos             return undef if $line =~ /^\s*$/;
     92  1.1  christos 
     93  1.1  christos             # All we got now is a dependency, just shave off surrounding spaces
     94  1.1  christos             $line =~ s/^\s+//;
     95  1.1  christos             $line =~ s/\s+$//;
     96  1.1  christos             return ($objfile, $line);
     97  1.1  christos         },
     98  1.1  christos     'VMS C' =>
     99  1.1  christos         sub {
    100  1.1  christos             state $abs_srcdir_shaved = undef;
    101  1.1  christos             state $srcdir_shaved = undef;
    102  1.1  christos 
    103  1.1  christos             unless (defined $abs_srcdir_shaved) {
    104  1.1  christos                 ($abs_srcdir_shaved = $abs_srcdir) =~ s|[>\]]$||;
    105  1.1  christos                 ($srcdir_shaved = $srcdir) =~ s|[>\]]$||;
    106  1.1  christos             }
    107  1.1  christos 
    108  1.1  christos             # current versions of DEC / Compaq / HP / VSI C strips away all
    109  1.1  christos             # directory information from the object file, so we must insert it
    110  1.1  christos             # back.  To make life simpler, we simply replace it with the
    111  1.1  christos             # corresponding .D file that's had its extension changed.  Since
    112  1.1  christos             # .D files are always written parallel to the object files, we
    113  1.1  christos             # thereby get the directory information for free.
    114  1.1  christos             (my $objfile = shift) =~ s|\.D$|.OBJ|i;
    115  1.1  christos             my $line = shift;
    116  1.1  christos 
    117  1.1  christos             # Shave off the target.
    118  1.1  christos             #
    119  1.1  christos             # The pattern for target and dependencies will always take this
    120  1.1  christos             # form:
    121  1.1  christos             #
    122  1.1  christos             #   target SPACE : SPACE deps
    123  1.1  christos             #
    124  1.1  christos             # This is so a volume delimiter (a : without any spaces around it)
    125  1.1  christos             # won't get mixed up with the target / deps delimiter.  We use this
    126  1.1  christos             # to easily identify what needs to be removed.
    127  1.1  christos             m|\s:\s|; $line = $';
    128  1.1  christos 
    129  1.1  christos             # We know that VMS has system header files in text libraries,
    130  1.1  christos             # extension .TLB.  We also know that our header files aren't stored
    131  1.1  christos             # in text libraries.  Finally, we know that VMS C produces exactly
    132  1.1  christos             # one dependency per line, so we simply discard any line ending with
    133  1.1  christos             # .TLB.
    134  1.1  christos             return undef if /\.TLB\s*$/;
    135  1.1  christos 
    136  1.1  christos             # All we got now is a dependency, just shave off surrounding spaces
    137  1.1  christos             $line =~ s/^\s+//;
    138  1.1  christos             $line =~ s/\s+$//;
    139  1.1  christos 
    140  1.1  christos             # VMS C gives us absolute paths, always.  Let's see if we can
    141  1.1  christos             # make them relative instead.
    142  1.1  christos             $line = lc canonpath($line);
    143  1.1  christos 
    144  1.1  christos             unless (defined $depconv_cache{$line}) {
    145  1.1  christos                 my $dep = $line;
    146  1.1  christos                 # Since we have already pre-populated the cache with
    147  1.1  christos                 # mappings for generated headers, we only need to deal
    148  1.1  christos                 # with the source tree.
    149  1.1  christos                 if ($dep =~ s|^\Q$abs_srcdir_shaved\E([\.>\]])?|$srcdir_shaved$1|i) {
    150  1.1  christos                     $depconv_cache{$line} = $dep;
    151  1.1  christos                 }
    152  1.1  christos             }
    153  1.1  christos             return ($objfile, $depconv_cache{$line})
    154  1.1  christos                 if defined $depconv_cache{$line};
    155  1.1  christos             print STDERR "DEBUG[VMS C]: ignoring $objfile <- $line\n"
    156  1.1  christos                 if $debug;
    157  1.1  christos 
    158  1.1  christos             return undef;
    159  1.1  christos         },
    160  1.1  christos     'VC' =>
    161  1.1  christos         sub {
    162  1.1  christos             # For the moment, we only support Visual C on native Windows, or
    163  1.1  christos             # compatible compilers.  With those, the flags /Zs /showIncludes
    164  1.1  christos             # give us the necessary output to be able to create dependencies
    165  1.1  christos             # that nmake (or any 'make' implementation) should be able to read,
    166  1.1  christos             # with a bit of help.  The output we're interested in looks like
    167  1.1  christos             # this (it always starts the same)
    168  1.1  christos             #
    169  1.1  christos             #   Note: including file: {whatever header file}
    170  1.1  christos             #
    171  1.1  christos             # Since there's no object file name at all in that information,
    172  1.1  christos             # we must construct it ourselves.
    173  1.1  christos 
    174  1.1  christos             (my $objfile = shift) =~ s|\.d$|.obj|i;
    175  1.1  christos             my $line = shift;
    176  1.1  christos 
    177  1.1  christos             # There are also other lines mixed in, for example compiler
    178  1.1  christos             # warnings, so we simply discard anything that doesn't start with
    179  1.1  christos             # the Note:
    180  1.1  christos 
    181  1.1  christos             if (/^Note: including file: */) {
    182  1.1  christos                 (my $tail = $') =~ s/\s*\R$//;
    183  1.1  christos 
    184  1.1  christos                 # VC gives us absolute paths for all include files, so to
    185  1.1  christos                 # remove system header dependencies, we need to check that
    186  1.1  christos                 # they don't match $abs_srcdir or $abs_blddir.
    187  1.1  christos                 $tail = lc canonpath($tail);
    188  1.1  christos 
    189  1.1  christos                 unless (defined $depconv_cache{$tail}) {
    190  1.1  christos                     my $dep = $tail;
    191  1.1  christos                     # Since we have already pre-populated the cache with
    192  1.1  christos                     # mappings for generated headers, we only need to deal
    193  1.1  christos                     # with the source tree.
    194  1.1  christos                     if ($dep =~ s|^\Q$abs_srcdir\E\\|\$(SRCDIR)\\|i) {
    195  1.1  christos                         $depconv_cache{$tail} = $dep;
    196  1.1  christos                     }
    197  1.1  christos                 }
    198  1.1  christos                 return ($objfile, '"'.$depconv_cache{$tail}.'"')
    199  1.1  christos                     if defined $depconv_cache{$tail};
    200  1.1  christos                 print STDERR "DEBUG[VC]: ignoring $objfile <- $tail\n"
    201  1.1  christos                     if $debug;
    202  1.1  christos             }
    203  1.1  christos 
    204  1.1  christos             return undef;
    205  1.1  christos         },
    206  1.1  christos );
    207  1.1  christos my %continuations = (
    208  1.1  christos     'gcc' => undef,
    209  1.1  christos     'makedepend' => "\\",
    210  1.1  christos     'VMS C' => "-",
    211  1.1  christos     'VC' => "\\",
    212  1.1  christos );
    213  1.1  christos 
    214  1.1  christos die "Producer unrecognised: $producer\n"
    215  1.1  christos     unless exists $procedures{$producer} && exists $continuations{$producer};
    216  1.1  christos 
    217  1.1  christos my $procedure = $procedures{$producer};
    218  1.1  christos my $continuation = $continuations{$producer};
    219  1.1  christos 
    220  1.1  christos my $buildfile_new = "$buildfile-$$";
    221  1.1  christos 
    222  1.1  christos my %collect = ();
    223  1.1  christos if (defined $procedure) {
    224  1.1  christos     foreach my $depfile (@depfiles) {
    225  1.1  christos         open IDEP,$depfile or die "Trying to read $depfile: $!\n";
    226  1.1  christos         while (<IDEP>) {
    227  1.1  christos             s|\R$||;                # The better chomp
    228  1.1  christos             my ($target, $deps) = $procedure->($depfile, $_);
    229  1.1  christos             $collect{$target}->{$deps} = 1 if defined $target;
    230  1.1  christos         }
    231  1.1  christos         close IDEP;
    232  1.1  christos     }
    233  1.1  christos }
    234  1.1  christos 
    235  1.1  christos open IBF, $buildfile or die "Trying to read $buildfile: $!\n";
    236  1.1  christos open OBF, '>', $buildfile_new or die "Trying to write $buildfile_new: $!\n";
    237  1.1  christos while (<IBF>) {
    238  1.1  christos     last if /^# DO NOT DELETE THIS LINE/;
    239  1.1  christos     print OBF or die "$!\n";
    240  1.1  christos }
    241  1.1  christos close IBF;
    242  1.1  christos 
    243  1.1  christos print OBF "# DO NOT DELETE THIS LINE -- make depend depends on it.\n";
    244  1.1  christos 
    245  1.1  christos if (defined $procedure) {
    246  1.1  christos     foreach my $target (sort keys %collect) {
    247  1.1  christos         my $prefix = $target . ' :';
    248  1.1  christos         my @deps = sort keys %{$collect{$target}};
    249  1.1  christos 
    250  1.1  christos         while (@deps) {
    251  1.1  christos             my $buf = $prefix;
    252  1.1  christos             $prefix = '';
    253  1.1  christos 
    254  1.1  christos             while (@deps && ($buf eq ''
    255  1.1  christos                                  || length($buf) + length($deps[0]) <= 77)) {
    256  1.1  christos                 $buf .= ' ' . shift @deps;
    257  1.1  christos             }
    258  1.1  christos             $buf .= ' '.$continuation if @deps;
    259  1.1  christos 
    260  1.1  christos             print OBF $buf,"\n" or die "Trying to print: $!\n"
    261  1.1  christos         }
    262  1.1  christos     }
    263  1.1  christos } else {
    264  1.1  christos     foreach my $depfile (@depfiles) {
    265  1.1  christos         open IDEP,$depfile or die "Trying to read $depfile: $!\n";
    266  1.1  christos         while (<IDEP>) {
    267  1.1  christos             print OBF or die "Trying to print: $!\n";
    268  1.1  christos         }
    269  1.1  christos         close IDEP;
    270  1.1  christos     }
    271  1.1  christos }
    272  1.1  christos 
    273  1.1  christos close OBF;
    274  1.1  christos 
    275  1.1  christos if (compare_text($buildfile_new, $buildfile) != 0) {
    276  1.1  christos     rename $buildfile_new, $buildfile
    277  1.1  christos         or die "Trying to rename $buildfile_new -> $buildfile: $!\n";
    278  1.1  christos }
    279  1.1  christos 
    280  1.1  christos END {
    281  1.1  christos     # On VMS, we want to remove all generations of this file, in case there
    282  1.1  christos     # are more than one, so we loop.
    283  1.1  christos     if (defined $buildfile_new) {
    284  1.1  christos         while (unlink $buildfile_new) {}
    285  1.1  christos     }
    286  1.1  christos }
    287