|
| 1 | +#! /usr/bin/perl |
| 2 | +# |
| 3 | +# Copyright (c) 2017, Oracle and/or its affiliates. All rights reserved. |
| 4 | +# |
| 5 | +# This program is free software; you can redistribute it and/or modify |
| 6 | +# it under the terms of the GNU General Public License as published by |
| 7 | +# the Free Software Foundation; version 2 of the License. |
| 8 | +# |
| 9 | +# This program is distributed in the hope that it will be useful, |
| 10 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 11 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 12 | +# GNU General Public License for more details. |
| 13 | +# |
| 14 | +# You should have received a copy of the GNU General Public License |
| 15 | +# along with this program; if not, write to the Free Software Foundation, |
| 16 | +# 51 Franklin Street, Suite 500, Boston, MA 02110-1335 USA |
| 17 | +# |
| 18 | + |
| 19 | +# |
| 20 | +# Take the given GCC command line and run it with all absolute paths |
| 21 | +# changed to relative paths. This makes sure that no part of the build |
| 22 | +# path leaks into the .o files, which it normally would through the |
| 23 | +# contents of __FILE__. (Debug information is also affected, but that |
| 24 | +# is already fixed through -fdebug-prefix-map=.) |
| 25 | +# |
| 26 | +# A more elegant solution would be -ffile-prefix-map=, but this is |
| 27 | +# not currently supported in GCC; see |
| 28 | +# https://gcc.gnu.org/bugzilla/show_bug.cgi?id=70268. |
| 29 | +# |
| 30 | + |
| 31 | +use strict; |
| 32 | +use warnings; |
| 33 | +use Cwd; |
| 34 | + |
| 35 | +my $cwd = getcwd(); |
| 36 | + |
| 37 | +my @newarg = (); |
| 38 | +for my $i (0..$#ARGV) { |
| 39 | + my $arg = $ARGV[$i]; |
| 40 | + if ($arg =~ /-I(.+)$/) { |
| 41 | + $arg = '-I' . relativize($1, $cwd); |
| 42 | + } elsif ($arg =~ /^\//) { |
| 43 | + $arg = relativize($arg, $cwd); |
| 44 | + } |
| 45 | + push @newarg, $arg; |
| 46 | +} |
| 47 | + |
| 48 | +exec(@newarg); |
| 49 | + |
| 50 | +# /a/b/c/foo from /a/b/d = ../c/foo |
| 51 | +sub relativize { |
| 52 | + my ($dir1, $dir2) = @_; |
| 53 | + |
| 54 | + if ($dir1 !~ /^\//) { |
| 55 | + # Not an absolute path. |
| 56 | + return $dir1; |
| 57 | + } |
| 58 | + |
| 59 | + if (! -e $dir1) { |
| 60 | +# print STDERR "Unknown file/directory $dir1.\n"; |
| 61 | + return $dir1; |
| 62 | + } |
| 63 | + # Resolve symlinks and such, because getcwd() does. |
| 64 | + $dir1 = Cwd::abs_path($dir1); |
| 65 | + |
| 66 | + if ($dir1 =~ /^\/(lib|tmp|usr)/) { |
| 67 | + # Not related to our source code. |
| 68 | + return $dir1; |
| 69 | + } |
| 70 | + |
| 71 | + if ($dir1 eq $dir2) { |
| 72 | + return "."; |
| 73 | + } |
| 74 | + |
| 75 | + my (@dir1_components) = split /\//, $dir1; |
| 76 | + my (@dir2_components) = split /\//, $dir2; |
| 77 | + |
| 78 | + # Remove common leading components. |
| 79 | + while (scalar @dir1_components > 0 && scalar @dir2_components > 0 && |
| 80 | + $dir1_components[0] eq $dir2_components[0]) { |
| 81 | + shift @dir1_components; |
| 82 | + shift @dir2_components; |
| 83 | + } |
| 84 | + |
| 85 | + my $ret = ""; |
| 86 | + for my $i (0..$#dir2_components) { |
| 87 | + $ret .= '../'; |
| 88 | + } |
| 89 | + $ret .= join('/', @dir1_components); |
| 90 | + |
| 91 | + # print STDERR "[$dir1] from [$dir2] => [$ret]\n"; |
| 92 | + |
| 93 | + return $ret; |
| 94 | +} |
| 95 | + |
0 commit comments