bin/diffgdb

   1 #! /usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 sub gitmark($) {
   6   my($s)=@_;
   7   return "" if $s!~m{^(... )([^/]*/+[^/]*)/};
   8   my($pfx,$dir)=($1,$2);
   9   local *GIT;
  10   $dir.="/build/gdbgit";
  11   return "" if !-d $dir;
  12   open GIT,"cd '$dir';git log --format=%H HEAD^..HEAD|" or return "";
  13   my $git=do { local $/; <GIT>; };
  14   close GIT;
  15   chomp $git;
  16   return "${pfx}GIT commit $git\n" if $git=~/^[0-9a-f]{40}$/;
  17   return "";
  18 }
  19
  20 my @ignore=(
  21 qr{^.PASS: }o,
  22 qr{^.KPASS: }o,
  23 qr{^-FAIL: }o,
  24 qr{^-KFAIL: }o,
  25 qr{^-XFAIL: }o,
  26 qr{^.Test Run By }o,
  27 qr{^.gnatbind }o,
  28 qr{^.gnatlink }o,
  29 qr{^.gnatlink: }o,
  30 qr{^.gnatmake: }o,
  31 qr{^.gcc }o,
  32 qr{^./usr/bin/ld: .* architecture of input file .* is incompatible with .* output\n$}o,
  33 qr{^.collect2: }o,
  34 #qr{^.UNSUPPORTED: }o,
  35 #qr{^.UNTESTED: }o,
  36 #qr{^.UNRESOLVED: }o,
  37 #qr{^.ERROR: }o,
  38 #qr{^.WARNING: }o,
  39 qr{^.[^:]*[.]ad[sb]:[0-9]}o,
  40 qr{^.gdb compile failed, }o,
  41 qr{^.gdb compile failed, /usr/bin/ld: /tmp/[a-zA-Z0-9]*.o: relocation R_X86_64_32S against `a local symbol. can not be used when making a shared object; recompile with -fPIC\n$}o,
  42 qr{^./tmp/[a-zA-Z0-9]*.o: could not read symbols: Bad value\n$}o,
  43 qr{^./tmp/[a-zA-Z0-9]*.s:\d+: Error: unrecognized symbol type "gnu_indirect_function"\n$}o,
  44 qr{^./tmp/[a-zA-Z0-9]*.o: In function `\S+':\n$}o,
  45 qr{^./tmp/[a-zA-Z0-9]*.o:.*: undefined reference to `.*'\n$}o,
  46 qr{^./tmp/[a-zA-Z0-9]*.s:\d+: Error: syntax error; found `.' but expected `,'\n$}o,
  47 qr{^./tmp/[a-zA-Z0-9]*.s:\d+: Error: junk at end of line: `.(?:plt|local)'\n$}o,
  48 qr{^./usr/bin/ld: /tmp/[a-zA-Z0-9]*.o\(\.text\+0x[0-9a-f]+\): unresolvable R_PPC64_REL24 relocation against symbol `\S+'\n$}o,
  49 qr{^.# of }o,
  50 qr{^./home/}o,
  51 qr{^.\.\./as-new [0-9.]*\n$}o,
  52 qr{^.(?:/unsafe)?ld/ld-new [0-9.]*\n$}o,
  53 qr{\bgdb version  \d\S+ -nw -nx\b}o,
  54 qr{^.FAIL: \S+\.exp: valgrind check \d+\n$}o,
  55 qr{^.KFAIL: gdb.threads/watchthreads2.exp: gdb can drop watchpoints in multithreaded app \(PRMS: gdb/10116\)\n$}o,
  56 qr{^.FAIL: gdb.base/info-os.exp: .*\n$}o,
  57 qr{^.FAIL: gdb.threads/multiple-step-overs.exp: .*\n$}o,
  58 qr{^.FAIL: gdb.base/random-signal.exp: stop with control-c \Q(timeout)\E\n$}o,
  59 );
  60 my $ignore=shift @ignore;
  61 $ignore=qr/$ignore|$_/ for @ignore;
  62
  63 my $opt_new;
  64 while (1) {
  65   if ($ARGV[0] eq "-r") {
  66     $ignore=undef;
  67     shift;
  68     next;
  69   }
  70   if ($ARGV[0] eq "-N") {
  71     $opt_new=1;
  72     shift;
  73     next;
  74   }
  75   last;
  76 }
  77
  78 my $last;
  79 my $lastfile;
  80 local *DIFF;
  81 my(@diff)=("diff","-rU-1",@ARGV);
  82 open DIFF,"-|",@diff or die join(" ",@diff).": $!";
  83 while (<DIFF>) {
  84   next if /^diff /;
  85   my($thisname)=m{^.(?:Running (?:.*/)?|[A-Z]+: )(gdb[.]\w+/\S+[.]exp)(?: \Q...\E|: .*)$};
  86   $thisname||=(m{^.\t\t=== gdb (Summary) ===\n$})[0];
  87   $thisname||=(m{^(Only in) })[0];
  88   my $this;
  89   if (!$thisname || ($last && $thisname eq $last->{"name"})) {
  90 #if (!$thisname) { print "X: !thisname\n"; } else { print "X: \"".$last->{"name"}."\" -> \"$thisname\"\n"; }
  91     $this=$last;
  92   } else {
  93 #print "X: new \"$thisname\"\n";
  94     $last=$this={"name"=>$thisname,"+Running"=>(/^[+]/||0)};
  95   }
  96   next if /^@@ .* @@\n$/;
  97   if ($this->{"print"}) {
  98     print;
  99     next;
 100   }
 101   if (/^Only in /) {
 102     $lastfile=$_;
 103   }
 104   if (/^--- /) {
 105     $lastfile=$_.gitmark($_);
 106     next;
 107   }
 108   if (/^\Q+++\E /) {
 109     $lastfile.=$_.gitmark($_);
 110     next;
 111   }
 112   $this->{"buffer"}.=$_;
 113   next if /^ /;
 114   next if /^[+]Running / && $thisname && !$opt_new;
 115   next if $ignore && /$ignore/o;
 116   next if /^[+]FAIL: / && $this->{"+Running"};
 117   next if /^[+]KFAIL: / && $this->{"+Running"};
 118   next if /^[+]XFAIL: / && $this->{"+Running"};
 119   next if /^[+]UNTESTED: / && $this->{"+Running"};
 120   next if /^[+]gdb compile failed, / && $this->{"+Running"};
 121   next if /^[+].*: Error: bad register name `%.*'\n$/ && $this->{"+Running"};
 122   next if /^[+].*: Error: `.*' is only supported in 64-bit mode\n$/ && $this->{"+Running"};
 123
 124   $this->{"print"}=1;
 125   print $lastfile||""; $lastfile=undef();
 126   print "\n#".($this->{"name"}||"???")."\n";
 127   print $this->{"buffer"}; $this->{"buffer"}=undef();
 128   next;
 129 }