blob: f9b11e287355791f55105ef7cb320a181bae19d8 (
plain)
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
|
#!/usr/bin/perl
# Copyright 2016 Timothe Litt litt at acm _ddot_ org
#
# May be freely used and copied providing this notice is retained
# No warranty, use at your own risk
#
# valgrind foo 3>&1 1>&2 2>&3 | grindmerge -f input >newrules
# Source: <https://wiki.wxwidgets.org/Parse_valgrind_suppressions.sh>
# See: <https://wiki.wxwidgets.org/Valgrind_Suppression_File_Howto>
use warnings;
use strict;
use Digest::MD5 qw/md5_hex/;
my %known;
my $dups = 0;
sub parse {
my $in = shift;
while( <$in> ) {
next unless( /^\{/ );
my $block = $_;
while( <$in> ) {
if( /^\}/ ) {
$block .= "}\n";
last;
}
$block .= $_;
}
last unless( defined $block );
if( $block !~ /\}\n/ ) {
print STDERR ("Unterminated suppression at line $.\n" );
last;
}
my $key = $block;
$key =~ s/(\A{[^\n]*\n)\s*[^\n]*\n/$1/;
my $sum = md5_hex( $key );
$dups++ if( exists $known{$sum} );
$known{$sum} = $block;
}
}
if( @ARGV >= 2 && $ARGV[0] eq '-f' ) {
if( open( my $db, '<', $ARGV[1] ) ) {
parse( $db );
close( $db );
} else {
print STDERR ("Open failed for $ARGV[1]: $!\n");
exit 1;
}
print STDERR ("Read " . keys( %known ) . " suppressions from $ARGV[1]\n" );
}
parse( \*STDIN );
print $known{$_} foreach ( sort keys %known );
print STDERR ("Squashed $dups duplicate suppressions\n")
|
