tools/gnmvalgrind

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 my $verbose = 1;
   6 my $seen_leak_check = 0;
   7 my $seen_num_callers = 0;
   8 my $program = undef;
   9 my @cmd = ();
  10
  11 my $topsrc = &find_topsrc ();
  12
  13 for (my $i = 0; $i < @ARGV;) {
  14     my $a = $ARGV[$i++];
  15
  16     $seen_leak_check = 1 if $a =~ /^--leak-check\b/;
  17     $seen_num_callers = 1 if $a =~ /^--num-callers\b/;
  18
  19     if ($a !~ /^-/) {
  20         if (!-x $a) {
  21             die "$0: failed to understand command line.\n";
  22         }
  23         if (-s _ < 50000) {
  24             push @cmd, "$topsrc/libtool", "--mode=execute";
  25         }
  26         $program = $a;
  27         last;
  28     }
  29 }
  30 die "$0: usage $0 [valgrind options] gnumeric [gnumeric-options]\n"
  31     unless $program;
  32
  33 &add_debug_flag ('G_SLICE', 'always-malloc');
  34 &add_debug_flag ('GNM_DEBUG', 'valgrind-bitfield-workarounds');
  35 if ($seen_leak_check) {
  36     &add_debug_flag ('G_DEBUG', 'resident-modules');
  37     &add_debug_flag ('GNM_DEBUG', 'close-displays');
  38 }
  39
  40 push @cmd, 'valgrind';
  41 push @cmd, '--num-callers=40' unless $seen_num_callers;
  42 push @cmd, "--suppressions=$topsrc/test/common.supp";
  43 push @cmd, "--suppressions=$topsrc/test/gui.supp";
  44 push @cmd, @ARGV;
  45
  46 print STDERR "Executing ", join (' ', map { &quotearg ($_) } @cmd), "\n" if $verbose;
  47 exec { $cmd[0] } @cmd
  48     or die "$0: failed to execute valgrind.\n";
  49
  50
  51 sub add_debug_flag {
  52     my ($var,$flag) = @_;
  53
  54     if (exists $ENV{$var}) {
  55         foreach my $f2 (split (':', $ENV{$var})) {
  56             return if $f2 eq $flag;
  57         }
  58         $ENV{$var} .= ":$flag";
  59     } else {
  60         $ENV{$var} = $flag;
  61     }
  62     print STDERR "Setting $var=", $ENV{$var}, "\n" if $verbose;
  63 }
  64
  65 sub find_topsrc {
  66     my $dir = '.';
  67
  68     for (1 ... 5) {
  69         if (-r "$dir/configure" && -r "$dir/gnumeric.xsd") {
  70             return $dir;
  71         }
  72
  73         $dir = "$dir/..";
  74         $dir =~ s{^\./}{};
  75     }
  76
  77     $dir = $0;
  78     $dir =~ s{/[^/]*$}{};
  79     for (1 ... 5) {
  80         if (-r "$dir/configure" && -r "$dir/gnumeric.xsd") {
  81             return $dir;
  82         }
  83
  84         $dir = "$dir/..";
  85         $dir =~ s{^\./}{};
  86     }
  87
  88
  89
  90     die "$0: Cannot find top-level directory.\n";
  91 }
  92
  93 sub quotearg {
  94     my ($arg) = @_;
  95
  96     return $arg if $arg =~ m{^[-a-zA-Z0-9_/=.,]+$};
  97     return "'$arg'" if $arg =~ m{^[-a-zA-Z0-9_/=., *?<>%&^!@#]*$};
  98
  99     my $res = '';
 100     while ($arg ne '') {
 101         if ($arg =~ m{^([-a-zA-Z0-9_/=.,]+)}) {
 102             $res .= $1;
 103             $arg = substr ($arg, length $1);
 104         } else {
 105             $res .= "\\" . substr ($arg, 0, 1);
 106             $arg = substr ($arg, 1);
 107         }
 108     }
 109     return $res;
 110 }