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
111
112
|
#!/usr/bin/perl -w
use strict;
my $verbose = 1;
my $seen_leak_check = 0;
my $seen_num_callers = 0;
my $program = undef;
my @cmd = ();
my $topsrc = &find_topsrc ();
for (my $i = 0; $i < @ARGV;) {
my $a = $ARGV[$i++];
$seen_leak_check = 1 if $a =~ /^--leak-check\b/;
$seen_num_callers = 1 if $a =~ /^--num-callers\b/;
if ($a !~ /^-/) {
if (!-x $a) {
die "$0: failed to understand command line.\n";
}
if (-s _ < 50000) {
push @cmd, "$topsrc/libtool", "--mode=execute";
}
$program = $a;
last;
}
}
die "$0: usage $0 [valgrind options] gnumeric [gnumeric-options]\n"
unless $program;
&add_debug_flag ('G_SLICE', 'always-malloc');
&add_debug_flag ('GNM_DEBUG', 'valgrind-bitfield-workarounds');
if ($seen_leak_check) {
&add_debug_flag ('G_DEBUG', 'resident-modules');
&add_debug_flag ('GNM_DEBUG', 'close-displays');
}
$ENV{'PYTHONMALLOC'} = 'malloc';
push @cmd, 'valgrind';
push @cmd, '--num-callers=40' unless $seen_num_callers;
push @cmd, "--suppressions=$topsrc/test/common.supp";
push @cmd, "--suppressions=$topsrc/test/gui.supp";
push @cmd, @ARGV;
print STDERR "Executing ", join (' ', map { "earg ($_) } @cmd), "\n" if $verbose;
exec { $cmd[0] } @cmd
or die "$0: failed to execute valgrind.\n";
sub add_debug_flag {
my ($var,$flag) = @_;
if (exists $ENV{$var}) {
foreach my $f2 (split (':', $ENV{$var})) {
return if $f2 eq $flag;
}
$ENV{$var} .= ":$flag";
} else {
$ENV{$var} = $flag;
}
print STDERR "Setting $var=", $ENV{$var}, "\n" if $verbose;
}
sub find_topsrc {
my $dir = '.';
for (1 ... 5) {
if (-r "$dir/configure" && -r "$dir/gnumeric.xsd") {
return $dir;
}
$dir = "$dir/..";
$dir =~ s{^\./}{};
}
$dir = $0;
$dir =~ s{/[^/]*$}{};
for (1 ... 5) {
if (-r "$dir/configure" && -r "$dir/gnumeric.xsd") {
return $dir;
}
$dir = "$dir/..";
$dir =~ s{^\./}{};
}
die "$0: Cannot find top-level directory.\n";
}
sub quotearg {
my ($arg) = @_;
return $arg if $arg =~ m{^[-a-zA-Z0-9_/=.,]+$};
return "'$arg'" if $arg =~ m{^[-a-zA-Z0-9_/=., *?<>%&^!@#]*$};
my $res = '';
while ($arg ne '') {
if ($arg =~ m{^([-a-zA-Z0-9_/=.,]+)}) {
$res .= $1;
$arg = substr ($arg, length $1);
} else {
$res .= "\\" . substr ($arg, 0, 1);
$arg = substr ($arg, 1);
}
}
return $res;
}
|
