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
|
use strict;
use IPC::Open3;
use Symbol 'gensym';
my @cmd=@ARGV;
my $err=gensym;
my $rc=0;
my $retry=1;
unless (grep { /^-f(?:no-)?diagnostics-color/ } @cmd) {
splice @cmd, 1, 0, (-t STDERR ? "-fdiagnostics-color" : "-fno-diagnostics-color");
}
while ($retry) {
open DupSTDIN, "<&", \*STDIN;
open DupSTDOUT, ">&", \*STDOUT;
my $pid=open3("<&DupSTDIN", ">&DupSTDOUT", $err, @cmd);
my @err=<$err>;
waitpid($pid,0);
$rc=$?;
if ($rc & 127) {
print STDERR @err, "\n$cmd[0] died with signal ", $rc & 127, ":\n";
exit(1);
}
$rc >>= 8;
if (!$rc) {
print STDERR @err if @err;
exit(0);
}
$retry=0;
eval {
require Cwd;
my $wrapper_file=Cwd::abs_path($cmd[-1]);
for (@err) {
if (my ($first_error_file, $line) = m{^\s*([^\s:]+):\s*(\d+)\s*:.*?(?i-:error):}) {
if (Cwd::abs_path($first_error_file) eq $wrapper_file) {
open IN, $wrapper_file
or die "can't read $wrapper_file: $!\n";
my @contents=<IN>;
close IN;
if ($contents[$line-1] =~ s/\bWrapperReturn((?:Lvalue|Anch|New)*)\w*/ObsoleteWrapper$1/) {
open OUT, ">", "$wrapper_file.new"
or die "can't create $wrapper_file.new: $!\n";
print OUT @contents;
close OUT;
rename "$wrapper_file.new", $wrapper_file
or die "can't rename $wrapper_file.new into $wrapper_file: $!\n";
$retry=1;
}
}
last;
}
}
};
print STDERR @err unless $retry;
print STDERR "\nAttempt to repair the wrapper code failed: $@" if $@;
}
exit($rc);
|
