scripts/extract_c_and_res.pl

   1 # Copyright 2010, INRIA, University of Copenhagen
   2 # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   3 # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   4 # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   5 # This file is part of Coccinelle.
   6 #
   7 # Coccinelle is free software: you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation, according to version 2 of the License.
  10 #
  11 # Coccinelle is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  18 #
  19 # The authors reserve the right to distribute this or future versions of
  20 # Coccinelle under other licenses.
  21
  22
  23 #!/usr/bin/perl -w
  24 use strict;
  25
  26 sub pr2 { print "$_[0]\n"; }
  27 sub mylog { print @_;}
  28
  29
  30 # to be launched from the git directory
  31 die "usage: $0 commithashafter [commithashbefore]"
  32   if(@ARGV <= 0 || @ARGV >= 3);
  33
  34 # update: now I also extract the headers files, the one
  35 # that were modified in the commit and the one that are
  36 # locally used and that may contain useful type information
  37 # for spatch.
  38
  39 # update: now I also extract some include/linux/header.h files, the
  40 # one having the same name of one of the driver.
  41
  42 my $target_dir = "/tmp/extract_c_and_res/$ARGV[0]";
  43 `mkdir -p $target_dir`;
  44 my $old_dir = "/tmp/extract_c_and_res/$ARGV[0]_old";
  45 `mkdir -p $old_dir`;
  46 my $new_dir = "/tmp/extract_c_and_res/$ARGV[0]_new";
  47 `mkdir -p $new_dir`;
  48
  49 my $commit_new = $ARGV[0];
  50 my $commit_old = $ARGV[1] || "$commit_new^"; # default parent
  51
  52 my $gitfile = "$target_dir/$commit_new.gitinfo";
  53 my $makefile = "$target_dir/Makefile";
  54
  55 `git show $commit_new > $gitfile `;
  56
  57
  58 # processing the patch
  59
  60 my @files = ();
  61 my $files = {};
  62 my @driverheaders_in_include = ();
  63
  64
  65 open FILE, "$gitfile" or die "$!";
  66 while(<FILE>) {
  67
  68   # allow other dir ? # fs|mm   there is drivers under arch/ too
  69   if(/^diff --git a\/((drivers|sound)\/.*?\.[ch]) b/){
  70         mylog "  $1\n";
  71
  72         push @files, $1;
  73         $files->{$1} = 1;
  74
  75     }
  76     elsif(/^diff --git a\/(include\/.*?\.h) b/) {
  77         mylog "potential header driver $1\n";
  78         push @driverheaders_in_include, $1;
  79     }
  80     elsif(/^diff --git a\//) {
  81       mylog " not driver:$_";
  82     }
  83     elsif(/^diff/) {
  84       die "PB: strange diff line: $_";
  85     }
  86 }
  87
  88 # extracting the .c and .h of the patch
  89
  90 my $counter=0;
  91
  92 # to be able to later find the corresponding local included header file
  93 my $kerneldir_of_file = {};
  94
  95 my @finalcfiles = ();
  96 my $finalcfiles = {};
  97
  98 foreach my $f (@files) {
  99   my ($base) = `basename $f`;
 100   chomp $base;
 101   my $res = $base;
 102   if($base =~ /\.c$/) {
 103     $res =~ s/\.c$/.res/;
 104   }
 105   if($base =~ /\.h$/) {
 106     $res =~ s/\.h$/.h.res/;
 107   }
 108
 109   pr2 "processing: $f $base $res";
 110   if(-e "$target_dir/$base") {
 111     $counter++;
 112     $base = "${counter}_$base";
 113     $res = "${counter}_$res";
 114     pr2 "try transform one file because already exist: $base";
 115     if($base =~ /\.h$/) {
 116       die "PB: Two header files share the same name: $base.";
 117     }
 118
 119   }
 120   die "PB: one of the file already exist: $base" if (-e "$target_dir/$base");
 121
 122   `git cat-file blob $commit_old:$f > $target_dir/$base`;
 123   `git cat-file blob $commit_new:$f > $target_dir/$res`;
 124
 125   `git cat-file blob $commit_old:$f > $old_dir/$base`;
 126   `git cat-file blob $commit_new:$f > $new_dir/$base`;
 127
 128   $kerneldir_of_file->{$base} = `dirname $f`;
 129   chomp $kerneldir_of_file->{$base};
 130
 131   push @finalcfiles, $base;
 132   $finalcfiles->{$base} = 1;
 133
 134
 135 }
 136
 137 # generate Makefile
 138
 139 open MAKE, ">$makefile" or die "$!";
 140 print MAKE "CEDESCRIPTION=\"\"\n";
 141 print MAKE "SP=foo.cocci\n";
 142 print MAKE "SOURCES = ";
 143 my $last = shift @finalcfiles;
 144 foreach my $f (@finalcfiles) {
 145   print MAKE "$f \\\n\t";
 146 }
 147 print MAKE "$last\n";
 148
 149 print MAKE "
 150
 151 TOP=../..
 152 include \$(TOP)/generic_makefile
 153 ";
 154
 155
 156
 157 # process potential driver headers of include/
 158
 159 foreach my $f (@driverheaders_in_include) {
 160   my $base = `basename $f`;
 161   chomp $base;
 162   if($base =~ /.h$/) {
 163     $base =~ s/.h$/.c/;
 164   } else { die "PB: internal error"; }
 165
 166
 167 # julia want all .h that were in the patch, not just the headers
 168 # of our heuristic. Hence the comment.
 169
 170 #  pr2 "$f $base";
 171 #  if(defined($finalcfiles->{$base})) {
 172   {
 173 #    pr2 "found header of driver in include/: $f of $base";
 174     my $dir = `dirname $f`;
 175     chomp $dir;
 176     `mkdir -p $target_dir/$dir`;
 177     `git cat-file blob $commit_old:$f > $target_dir/$f`;
 178     `git cat-file blob $commit_new:$f > $target_dir/$f.res`;
 179
 180     `mkdir -p $old_dir/$dir`;
 181     `mkdir -p $new_dir/$dir`;
 182     `git cat-file blob $commit_old:$f > $old_dir/$f`;
 183     `git cat-file blob $commit_new:$f > $new_dir/$f`;
 184
 185   }
 186 }
 187
 188 # compute other linux headers not in the patch
 189
 190 my @linuxheaders  = `cd $target_dir; grep -E \"#include +\<[^>]*\>\" *.c *.h`;
 191 foreach my $line (@linuxheaders) {
 192   chomp $line;
 193   #pr2 ($line);
 194   if($line =~ /^(.*)?:#include *\<([^>]*)\>/) {
 195     my ($_file, $f) = ($1, $2);
 196
 197     my $base = `basename $f`;
 198     chomp $base;
 199     if($base =~ /.h$/) {
 200       $base =~ s/.h$/.c/;
 201     } else { die "PB: internal error"; }
 202
 203     if(defined($finalcfiles->{$base}) && ! -e "$target_dir/include/$f") {
 204       pr2 "found header of driver in include/: $f of $base";
 205       my $dir = `dirname $f`;
 206       chomp $dir;
 207       `mkdir -p $target_dir/include/$dir`;
 208       `git cat-file blob $commit_old:include/$f > $target_dir/include/$f`;
 209     }
 210   } else { pr2 "pb regexp: $line"; }
 211 }
 212
 213
 214 # compute other local headers not in the patch
 215
 216 my @headers  = `cd $target_dir; grep -E \"#include +\\".*\\"\" *.c *.h`;
 217
 218 my $hfiles = {};
 219 foreach my $line (@headers) {
 220   chomp $line;
 221   #pr2 ($line);
 222   if($line =~ /^(.*)?:#include *"(.*)"/) {
 223
 224     my ($file, $header) = ($1, $2);
 225     my $dir = $kerneldir_of_file->{$file};
 226
 227     my $fullheader = "$dir/$header";
 228     #pr2 ($fullheader);
 229
 230     if($files->{$fullheader}) {
 231       pr2 "INFO: $fullheader was already in commit";
 232     } else {
 233       $hfiles->{$fullheader} = 1;
 234     }
 235
 236   } else { pr2 "pb regexp: $line"; }
 237
 238 }
 239
 240 foreach my $h (keys %{$hfiles}) {
 241   my ($base) = `basename $h`;
 242   chomp $base;
 243   pr2 "processing additionnal header file: $h $base";
 244
 245   if(-e "$target_dir/$base") {
 246     pr2 "-------------------------------------";
 247     pr2 "PB: local header (not modified in the git) $base already exists";
 248     pr2 "BUT I CONTINUE, but may have more .failed in the end";
 249     pr2 "-------------------------------------";
 250   } else {
 251     `git cat-file blob $commit_old:$h > $target_dir/$base`;
 252   }
 253 }