tools/gnmgdb

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