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
|
#!/usr/bin/perl
### THIS IS DESIGNED TO BE RUN BY MAKE! DO NOT RUN FROM THE SHELL (because it MIGHT sigterm the shell)! ###
use strict;
use warnings FATAL => qw(all);
use POSIX ();
# Runs the compiler, passing it the given arguments.
# Filters select output from the compiler's standard error channel and
# can take different actions as a result.
# NOTE: this is *NOT* a hash (sadly: a hash would stringize all the regexes and thus render them useless, plus you can't index a hash based on regexes anyway)
# even though we use the => in it.
# The subs are passed the message, and anything the regex captured.
my @msgfilters = (
[ qr/^(.*) warning: cannot pass objects of non-POD type `(.*)' through `\.\.\.'; call will abort at runtime/ => sub {
my ($msg, $where, $type) = @_;
my $errstr = "$where error: cannot pass objects of non-POD type `$type' through `...'\n";
if ($type =~ m/::string/) {
$errstr .= "$where (Did you forget to call c_str()?)\n";
}
die $errstr;
} ],
[ qr/^.* warning: / => sub {
my ($msg) = @_;
print STDERR "\e[33;1m$msg\e[0m\n";
} ],
[ qr/^.* error: / => sub {
my ($msg) = @_;
print STDERR "\e[31;1m$msg\e[0m\n";
} ],
);
my $pid;
my ($r_stderr, $w_stderr);
my $cc = shift(@ARGV);
if (!defined($cc) || $cc eq "") {
die "Compiler not specified!\n";
}
pipe($r_stderr, $w_stderr) or die "pipe stderr: $!\n";
$pid = fork;
die "Cannot fork to start gcc! $!\n" unless defined($pid);
if ($pid) {
my $fail = 0;
# Parent - Close child-side pipes.
close $w_stderr;
# Close STDIN to ensure no conflicts with child.
close STDIN;
# Now read each line of stderr
LINE: while (defined(my $line = <$r_stderr>)) {
chomp $line;
for my $filter (@msgfilters) {
my @caps;
if (@caps = ($line =~ $filter->[0])) {
$@ = "";
eval {
$filter->[1]->($line, @caps);
};
if ($@) {
$fail = 1;
print STDERR $@;
}
next LINE;
}
}
print STDERR "$line\n";
}
waitpid $pid, 0;
close $r_stderr;
my $exit = $?;
# Simulate the same exit, so make gets the right termination info.
if (POSIX::WIFSIGNALED($exit)) {
# Make won't get the right termination info (it gets ours, not the compiler's), so we must tell the user what really happened ourselves!
print STDERR "$cc killed by signal " . POSIX::WTERMSIGN($exit) . "\n";
kill "TERM", getppid(); # Needed for bsd make.
kill "TERM", $$;
}
else {
if (POSIX::WEXITSTATUS($exit) == 0) {
if ($fail) {
kill "TERM", getppid(); # Needed for bsd make.
kill "TERM", $$;
}
exit 0;
} else {
exit POSIX::WEXITSTATUS($exit);
}
}
} else {
# Child - Close parent-side pipes.
close $r_stderr;
# Divert stderr
open STDERR, ">&", $w_stderr or die "Cannot divert STDERR: $!\n";
# Run the compiler!
exec { $cc } $cc, @ARGV;
die "exec $cc: $!\n";
}
|
