Porting/bisect.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 =for comment
   5
   6 Documentation for this is in bisect-runner.pl
   7
   8 =cut
   9
  10 # The default, auto_abbrev will treat -e as an abbreviation of --end
  11 # Which isn't what we want.
  12 use Getopt::Long qw(:config pass_through no_auto_abbrev);
  13 use File::Spec;
  14 use File::Path qw(mkpath);
  15
  16 my ($start, $end, $validate, $usage, $bad, $jobs, $make, $gold,
  17     $module, $with_module);
  18
  19 my $need_cpan_config;
  20 my $cpan_config_dir;
  21
  22 $bad = !GetOptions('start=s' => \$start, 'end=s' => \$end,
  23                    'jobs|j=i' => \$jobs, 'make=s' => \$make, 'gold=s' => \$gold,
  24                    validate => \$validate, 'usage|help|?' => \$usage,
  25                    'module=s' => \$module, 'with-module=s' => \$with_module,
  26                    'cpan-config-dir=s' => \$cpan_config_dir);
  27 unshift @ARGV, '--help' if $bad || $usage;
  28 unshift @ARGV, '--validate' if $validate;
  29
  30 if ($module || $with_module) {
  31   unshift @ARGV, '--module', $module if defined $module;
  32   unshift @ARGV, '--with-module', $with_module if defined $with_module;
  33
  34   if ($cpan_config_dir) {
  35     my $c = File::Spec->catfile($cpan_config_dir, 'CPAN', 'MyConfig.pm');
  36     die "--cpan-config-dir: $c does not exist\n" unless -e $c;
  37
  38     unshift @ARGV, '--cpan-config-dir', $cpan_config_dir;
  39   } else {
  40     $need_cpan_config = 1;
  41   }
  42 }
  43
  44 my $runner = $0;
  45 $runner =~ s/bisect\.pl/bisect-runner.pl/;
  46
  47 die "Can't find bisect runner $runner" unless -f $runner;
  48
  49 system $^X, $runner, '--check-args', '--check-shebang', @ARGV and exit 255;
  50 exit 255 if $bad;
  51 exit 0 if $usage;
  52
  53 my $start_time = time;
  54
  55 if (!defined $jobs &&
  56     !($^O eq 'hpux' && system((defined $make ? $make : 'make')
  57                               . ' --version >/dev/null 2>&1'))) {
  58     # Try to default to (ab)use all the CPUs:
  59     my $cpus;
  60     if (open my $fh, '<', '/proc/cpuinfo') {
  61         while (<$fh>) {
  62             ++$cpus if /^processor\s+:\s+\d+$/;
  63         }
  64     } elsif (-x '/sbin/sysctl' || -x '/usr/sbin/sysctl') {
  65         my $sysctl =  '/sbin/sysctl';
  66         $sysctl =  "/usr$sysctl" unless -x $sysctl;
  67         $cpus =  $1 if `$sysctl hw.ncpu` =~ /^hw\.ncpu: (\d+)$/;
  68     } elsif (-x '/usr/bin/getconf') {
  69         $cpus = $1 if `/usr/bin/getconf _NPROCESSORS_ONLN` =~ /^(\d+)$/;
  70     }
  71     $jobs = defined $cpus ? $cpus + 1 : 2;
  72 }
  73
  74 unshift @ARGV, '--jobs', $jobs if defined $jobs;
  75 unshift @ARGV, '--make', $make if defined $make;
  76
  77 if ($need_cpan_config) {
  78   # Make sure we have a CPAN::MyConfig so if we start at an old
  79   # revision CPAN doesn't ask for user input to configure itself
  80
  81   my $cdir = File::Spec->catdir($ENV{HOME},".cpan","CPAN");
  82   my $cfile = File::Spec->catfile($cdir, "MyConfig.pm");
  83
  84   unless (-e $cfile) {
  85     printf <<EOF;
  86 I could not find a CPAN::MyConfig. We need to create one now so that
  87 you can bisect with --module or --with-module. I'll boot up the CPAN
  88 shell for you. Feel free to use defaults or change things as needed.
  89 We recommend using 'manual' over 'local::lib' if it asks.
  90
  91 Type 'quit' when finished.
  92
  93 EOF
  94     system("$^X -MCPAN -e shell");
  95   }
  96 }
  97
  98 # We try these in this order for the start revision if none is specified.
  99 my @stable = map {chomp $_; $_} grep {/v5\.[0-9]+[02468]\.0$/} `git tag -l`;
 100 die "git tag -l didn't seem to return any tags for stable releases"
 101     unless @stable;
 102 unshift @stable, qw(perl-5.005 perl-5.6.0 perl-5.8.0);
 103
 104 {
 105     my ($dev_C, $ino_C) = stat 'Configure';
 106     my ($dev_c, $ino_c) = stat 'configure';
 107     if (defined $dev_C && defined $dev_c
 108         && $dev_C == $dev_c && $ino_C == $ino_c) {
 109         print "You seem to be on a case-insensitive file system.\n\n";
 110     } else {
 111         unshift @stable, qw(perl-5.002 perl-5.003 perl-5.004)
 112     }
 113 }
 114
 115 unshift @ARGV, '--gold', defined $gold ? $gold : $stable[-1];
 116
 117 if (!defined $end) {
 118     # If we have a branch blead, use that as the end
 119     $end = `git rev-parse --verify --quiet blead`;
 120     die unless defined $end;
 121     if (!length $end) {
 122         # Else use whichever is newer - HEAD, or the most recent stable tag.
 123         if (`git rev-list -n1 HEAD ^$stable[-1]` eq "") {
 124             $end = pop @stable;
 125         } else {
 126             $end = 'HEAD';
 127         }
 128     }
 129 }
 130
 131 # Canonicalising branches to revisions before moving the checkout permits one
 132 # to use revisions such as 'HEAD' for --start or --end
 133 foreach ($start, $end) {
 134     next unless $_;
 135     $_ = `git rev-parse $_`;
 136     die unless defined $_;
 137     chomp;
 138 }
 139
 140 {
 141     my $modified = my @modified = `git ls-files --modified --deleted --others`;
 142
 143     my ($dev0, $ino0) = stat $0;
 144     die "Can't stat $0: $!" unless defined $ino0;
 145     my ($dev1, $ino1) = stat 'Porting/bisect.pl';
 146
 147     my $inplace = defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1;
 148
 149     if ($modified) {
 150         my $final = $inplace
 151             ? "Can't run a bisect using a dirty directory containing $runner"
 152             : "You can use 'git clean -Xdf' to cleanup the ignored files";
 153
 154         die "This checkout is not clean, found file(s):\n",
 155             join("\t","",@modified),
 156                 "$modified modified, untracked, or other file(s)\n",
 157                 "These files may not show in git status as they may be ignored.\n",
 158                 "$final.\n";
 159     }
 160
 161     if ($inplace) {
 162         # We assume that it's safe to copy the runner to the temporary
 163         # directory and run it from there, because a shared /tmp should be +t
 164         # and hence others are not be able to delete or rename our file.
 165         require File::Temp;
 166         my ($to, $toname) = File::Temp::tempfile();
 167         die "Can't create tempfile"
 168             unless $to;
 169         open my $from, '<', $runner
 170             or die "Can't open '$runner': $!";
 171         local $/;
 172         print {$to} <$from>
 173             or die "Can't copy from '$runner' to '$toname': $!";
 174         close $from
 175             or die "Can't close '$runner': $!";
 176         close $to
 177             or die "Can't close '$toname': $!";
 178         chmod 0500, $toname
 179             or die "Can't chmod 0500, '$toname': $!";
 180         $runner = $toname;
 181         system $^X, $runner, '--check-args', @ARGV
 182             and die "Can't run inplace for some reason. :-(";
 183     }
 184 }
 185
 186 sub validate {
 187     my $commit = shift;
 188     if (defined $start && `git rev-list -n1 $commit ^$start^` eq "") {
 189         print "Skipping $commit, as it is earlier than $start\n";
 190         return;
 191     }
 192     if (defined $end && `git rev-list -n1 $end ^$commit^` eq "") {
 193         print "Skipping $commit, as it is more recent than $end\n";
 194         return;
 195     }
 196     print "Testing $commit...\n";
 197     system "git checkout $commit </dev/null" and die;
 198     my $ret = system $^X, $runner, '--no-clean', @ARGV;
 199     die "Runner returned $ret, not 0 for revision $commit" if $ret;
 200     system 'git clean -dxf </dev/null' and die;
 201     system 'git reset --hard HEAD </dev/null' and die;
 202     return $commit;
 203 }
 204
 205 if ($validate) {
 206     require Text::Wrap;
 207     my @built = map {validate $_} 'blead', reverse @stable;
 208     if (@built) {
 209         print Text::Wrap::wrap("", "", "Successfully validated @built\n");
 210         exit 0;
 211     }
 212     print "Did not validate anything\n";
 213     exit 1;
 214 }
 215
 216 my $git_version = `git --version`;
 217 if (defined $git_version
 218     && $git_version =~ /\Agit version (\d+\.\d+\.\d+)(.*)/) {
 219     $git_version = eval "v$1";
 220 } else {
 221     $git_version = v0.0.0;
 222 }
 223
 224 if ($git_version ge v1.6.6) {
 225     system "git bisect reset HEAD" and die;
 226 } else {
 227     system "git bisect reset" and die;
 228 }
 229
 230 # Sanity check the first and last revisions:
 231 system "git checkout $end" and die;
 232 my $ret = system $^X, $runner, @ARGV;
 233 die "Runner returned $ret for end revision" unless $ret;
 234 die "Runner returned $ret for end revision, which is a skip"
 235     if $ret == 125 * 256;
 236
 237 if (defined $start) {
 238     system "git checkout $start" and die;
 239     my $ret = system $^X, $runner, @ARGV;
 240     die "Runner returned $ret, not 0 for start revision" if $ret;
 241 } else {
 242     # Try to find the earliest version for which the test works
 243     my @tried;
 244     foreach my $try (@stable) {
 245         if (`git rev-list -n1 $end ^$try^` eq "") {
 246             print "Skipping $try, as it is more recent than end commit "
 247                 . (substr $end, 0, 16) . "\n";
 248             # As @stable is supposed to be in age order, arguably we should
 249             # last; here.
 250             next;
 251         }
 252         system "git checkout $try" and die;
 253         my $ret = system $^X, $runner, @ARGV;
 254         if (!$ret) {
 255             $start = $try;
 256             last;
 257         }
 258         push @tried, $try;
 259     }
 260     die "Can't find a suitable start revision to default to.\nTried @tried"
 261         unless defined $start;
 262 }
 263
 264 system "git bisect start" and die;
 265 system "git bisect good $start" and die;
 266 system "git bisect bad $end" and die;
 267
 268 # And now get git bisect to do the hard work:
 269 system 'git', 'bisect', 'run', $^X, $runner, @ARGV and die;
 270
 271 END {
 272     my $end_time = time;
 273
 274     printf "That took %d seconds.\n", $end_time - $start_time
 275         if defined $start_time;
 276 }
 277
 278 =for comment
 279
 280 Documentation for this is in bisect-runner.pl
 281
 282 =cut
 283
 284 # ex: set ts=8 sts=4 sw=4 et: