X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f624cb736a20c433d4e81c202222fc4ff50afe4c..0dd3e67ea7cc472669925a46c372becbd5df557a:/Porting/bisect-runner.pl

diff --git a/Porting/bisect-runner.pl b/Porting/bisect-runner.pl
index 4d7a6f2..16caab6 100755
--- a/Porting/bisect-runner.pl
+++ b/Porting/bisect-runner.pl
@@ -4,6 +4,8 @@ use strict;
 use Getopt::Long qw(:config bundling no_auto_abbrev);
 use Pod::Usage;
 use Config;
+use File::Temp qw(tempdir);
+use File::Spec;
 
 my @targets
     = qw(none config.sh config.h miniperl lib/Config.pm Fcntl perl test_prep);
@@ -64,6 +66,8 @@ unless(GetOptions(\%options,
                   'test-build', 'validate',
                   'all-fixups', 'early-fixup=s@', 'late-fixup=s@', 'valgrind',
                   'check-args', 'check-shebang!', 'usage|help|?', 'gold=s',
+                  'module=s', 'with-module=s', 'cpan-config-dir=s',
+                  'test-module=s', 'no-module-tests',
                   'A=s@',
                   'D=s@' => sub {
                       my (undef, $val) = @_;
@@ -124,9 +128,23 @@ if (defined $target && $target =~ /\.t\z/) {
 }
 
 pod2usage(exitval => 255, verbose => 1)
-    unless @ARGV || $match || $options{'test-build'} || defined $options{'one-liner'};
+    unless @ARGV || $match || $options{'test-build'}
+        || defined $options{'one-liner'} || defined $options{module}
+        || defined $options{'test-module'};
 pod2usage(exitval => 255, verbose => 1)
     if !$options{'one-liner'} && ($options{l} || $options{w});
+if ($options{'no-module-tests'} && $options{module}) {
+    print STDERR "--module and --no-module-tests are exclusive.\n\n";
+    pod2usage(exitval => 255, verbose => 1)
+}
+if ($options{'no-module-tests'} && $options{'test-module'}) {
+    print STDERR "--test-module and --no-module-tests are exclusive.\n\n";
+    pod2usage(exitval => 255, verbose => 1)
+}
+if ($options{module} && $options{'test-module'}) {
+    print STDERR "--module and --test-module are exclusive.\n\n";
+    pod2usage(exitval => 255, verbose => 1)
+}
 
 check_shebang($ARGV[0])
     if $options{'check-shebang'} && @ARGV && !$options{match};
@@ -139,27 +157,33 @@ bisect.pl - use git bisect to pinpoint changes
 
 =head1 SYNOPSIS
 
-    # When did this become an error?
-    .../Porting/bisect.pl -e 'my $a := 2;'
-    # When did this stop being an error?
-    .../Porting/bisect.pl --expect-fail -e '1 // 2'
-    # When did this test start failing?
-    .../Porting/bisect.pl --target t/op/sort.t
-    # When were all lines matching this pattern removed from all files?
-    .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b'
-    # When was some line matching this pattern added to some file?
-    .../Porting/bisect.pl --expect-fail --match '\buseithreads\b'
-    # When did this test program stop exiting 0?
-    .../Porting/bisect.pl -- ./perl -Ilib ../test_prog.pl
-    # When did this test program start crashing (any signal or coredump)?
-    .../Porting/bisect.pl --crash -- ./perl -Ilib ../test_prog.pl
-    # When did this first become valid syntax?
-    .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \
-         --expect-fail -e 'my $a := 2;'
-    # What was the last revision to build with these options?
-    .../Porting/bisect.pl --test-build -Dd_dosuid
-    # When did this test program start generating errors from valgrind?
-    .../Porting/bisect.pl --valgrind ../test_prog.pl
+ # When did this become an error?
+ .../Porting/bisect.pl -e 'my $a := 2;'
+ # When did this stop being an error?
+ .../Porting/bisect.pl --expect-fail -e '1 // 2'
+ # When did this test start failing?
+ .../Porting/bisect.pl --target t/op/sort.t
+ # When were all lines matching this pattern removed from all files?
+ .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b'
+ # When was some line matching this pattern added to some file?
+ .../Porting/bisect.pl --expect-fail --match '\buseithreads\b'
+ # When did this test program stop exiting 0?
+ .../Porting/bisect.pl -- ./perl -Ilib ../test_prog.pl
+ # When did this test program start crashing (any signal or coredump)?
+ .../Porting/bisect.pl --crash -- ./perl -Ilib ../test_prog.pl
+ # When did this first become valid syntax?
+ .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \
+      --expect-fail -e 'my $a := 2;'
+ # What was the last revision to build with these options?
+ .../Porting/bisect.pl --test-build -Dd_dosuid
+ # When did this test program start generating errors from valgrind?
+ .../Porting/bisect.pl --valgrind ../test_prog.pl
+ # When did these cpan modules start failing to compile/pass tests?
+ .../Porting/bisect.pl --module=autobox,Moose
+ # When did this code stop working in blead with these modules?
+ .../Porting/bisect.pl --with-module=Moose,Moo -e 'use Moose; 1;'
+ # Like the above 2 but with custom CPAN::MyConfig
+ .../Porting/bisect.pl --module=Moo --cpan-config-dir=/home/blah/custom/
 
 =head1 DESCRIPTION
 
@@ -511,6 +535,12 @@ always exits with zero. If you require more flexibility than this, either
 specify your C<valgrind> invocation explicitly as part of the test case, or
 use a wrapper script to control the command line or massage the exit codes.
 
+In order for the test program to be seen as a perl script to valgrind
+(rather than a shell script), the first line must be one of the following
+
+  #!./perl
+  #!./miniperl
+
 =item *
 
 --test-build
@@ -539,6 +569,97 @@ even link.
 
 =item *
 
+--module module1,module2,...
+
+Install this (or these) module(s), die when it (the last of those)
+cannot be updated to the current version.
+
+Misnomer. the argument can be any argument that can be passed to CPAN
+shell's install command. B<But>: since we only have the uptodate
+command to verify that an install has taken place, we are unable to
+determine success for arguments like
+MSCHWERN/Test-Simple-1.005000_005.tar.gz.
+
+In so far, it is not such a misnomer.
+
+Note that this and I<--with-module> will both require a C<CPAN::MyConfig>.
+If F<$ENV{HOME}/.cpan/CPAN/MyConfig.pm> does not exist, a CPAN shell will
+be started up for you so you can configure one. Feel free to let
+CPAN pick defaults for you. Enter 'quit' when you are done, and
+then everything should be all set. Alternatively, you may
+specify a custom C<CPAN::MyConfig> by using I<--cpan-config-dir>.
+
+Also, if you want to bisect a module that needs a display (like
+TK) and you don't want random screens appearing and disappearing
+on your computer while you're working, you can do something like
+this:
+
+In a terminal:
+
+ $ while true; do date ; if ! ps auxww | grep -v grep \
+   | grep -q Xvfb; then Xvfb :121 & fi; echo -n 'sleeping 60 '; \
+   sleep 60; done
+
+And then:
+
+  DISPLAY=":121" .../Porting/bisect.pl --module=TK
+
+(Some display alternatives are vncserver and Xnest.)
+
+=item *
+
+--with-module module1,module2,...
+
+Like I<--module> above, except this simply installs the requested
+modules and they can then be used in other tests.
+
+For example:
+
+  .../Porting/bisect.pl --with-module=Moose -e 'use Moose; ...'
+
+=item *
+
+--no-module-tests
+
+Use in conjunction with I<--with-module> to install the modules without
+running their tests. This can be a big time saver.
+
+For example:
+
+  .../Porting/bisect.pl --with-module=Moose --no-module-tests \
+       -e 'use Moose; ...'
+
+=item *
+
+--test-module
+
+This is like I<--module>, but just runs the module's tests, instead of
+installing it.
+
+WARNING: This is a somewhat experimental option, known to work on recent
+CPAN shell versions.  If you use this option and strange things happen,
+please report them.
+
+Usually, you can just use I<--module>, but if you are getting inconsistent
+installation failures and you just want to see when the tests started
+failing, you might find this option useful.
+
+=item *
+
+--cpan-config-dir /home/blah/custom
+
+If defined, this will cause L<CPAN> to look for F<CPAN/MyConfig.pm> inside of
+the specified directory, instead of using the default config of
+F<$ENV{HOME}/.cpan/>.
+
+If no default config exists, a L<CPAN> shell will be fired up for you to
+configure things. Letting L<CPAN> automatically configure things for you
+should work well enough. You probably want to choose I<manual> instead of
+I<local::lib> if it asks. When you're finished with configuration, just
+type I<q> and hit I<ENTER> and the bisect should continue.
+
+=item *
+
 --force-manifest
 
 By default, a build will "skip" if any files listed in F<MANIFEST> are not
@@ -1176,7 +1297,7 @@ sub match_and_exit {
         while (<$fh>) {
             if ($_ =~ $re) {
                 ++$matches;
-                if (tr/\t\r\n -~\200-\377//c) {
+                if (/[^[:^cntrl:]\h\v]/) { # Matches non-spacing non-C1 controls
                     print "Binary file $file matches\n";
                 } else {
                     $_ .= "\n" unless /\n\z/;
@@ -1305,6 +1426,17 @@ foreach my $key (sort keys %defines) {
 }
 push @ARGS, map {"-A$_"} @{$options{A}};
 
+my $prefix;
+
+# Testing a module? We need to install perl/cpan modules to a temp dir
+if ($options{module} || $options{'with-module'} || $options{'test-module'})
+{
+  $prefix = tempdir(CLEANUP => 1);
+
+  push @ARGS, "-Dprefix=$prefix";
+  push @ARGS, "-Uversiononly", "-Dinstallusrbinperl=n";
+}
+
 # If a file in MANIFEST is missing, Configure asks if you want to
 # continue (the default being 'n'). With stdin closed or /dev/null,
 # it exits immediately and the check for config.sh below will skip.
@@ -1320,7 +1452,15 @@ if (-f 'config.sh') {
     # Emulate noextensions if Configure doesn't support it.
     fake_noextensions()
         if $major < 10 && $defines{noextensions};
-    system_or_die('./Configure -S');
+    if (system './Configure -S') {
+        # See commit v5.23.5-89-g7a4fcb3.  Configure may try to run
+        # ./optdef.sh instead of UU/optdef.sh.  Copying the file is
+        # easier than patching Configure (which mentions optdef.sh multi-
+        # ple times).
+        require File::Copy;
+        File::Copy::copy("UU/optdef.sh", "./optdef.sh");
+        system_or_die('./Configure -S');
+    }
 }
 
 if ($target =~ /config\.s?h/) {
@@ -1400,11 +1540,76 @@ if ($expected_file_found && $expected_file eq 't/perl') {
     }
 }
 
+my $just_testing = 0;
+
 if ($options{'test-build'}) {
     report_and_exit($expected_file_found, 'could build', 'could not build',
                     $real_target);
 } elsif (!$expected_file_found) {
     skip("could not build $real_target");
+} elsif (my $mod_opt = $options{module} || $options{'with-module'}
+               || ($just_testing++, $options{'test-module'})) {
+  # Testing a cpan module? See if it will install
+  # First we need to install this perl somewhere
+  system_or_die('./installperl');
+
+  my @m = split(',', $mod_opt);
+
+  my $bdir = File::Temp::tempdir(
+    CLEANUP => 1,
+  ) or die $!;
+
+  # Don't ever stop to ask the user for input
+  $ENV{AUTOMATED_TESTING} = 1;
+  $ENV{PERL_MM_USE_DEFAULT} = 1;
+
+  # Don't let these interfere with our cpan installs
+  delete $ENV{PERL_MB_OPT};
+  delete $ENV{PERL_MM_OPT};
+
+  # Make sure we load up our CPAN::MyConfig and then
+  # override the build_dir so we have a fresh one
+  # every build
+  my $cdir = $options{'cpan-config-dir'}
+          || File::Spec->catfile($ENV{HOME},".cpan");
+
+  my @cpanshell = (
+    "$prefix/bin/perl",
+    "-I", "$cdir",
+    "-MCPAN::MyConfig",
+    "-MCPAN",
+    "-e","\$CPAN::Config->{build_dir}=q{$bdir};",
+    "-e",
+  );
+
+  for (@m) {
+    s/-/::/g if /-/ and !m|/|;
+  }
+  my $install = join ",", map { "'$_'" } @m;
+  if ($just_testing) {
+    $install = "test($install)";
+  } elsif ($options{'no-module-tests'}) {
+    $install = "notest('install',$install)";
+  } else {
+    $install = "install($install)";
+  }
+  my $last = $m[-1];
+  my $status_method = $just_testing ? 'test' : 'uptodate';
+  my $shellcmd = "$install; die unless CPAN::Shell->expand(Module => '$last')->$status_method;";
+
+  if ($options{module} || $options{'test-module'}) {
+    run_report_and_exit(@cpanshell, $shellcmd);
+  } else {
+    my $ret = run_with_options({setprgp => $options{setpgrp},
+                                timeout => $options{timeout},
+                               }, @cpanshell, $shellcmd);
+    $ret &= 0xff if $options{crash};
+
+    # Failed? Give up
+    if ($ret) {
+      report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_");
+    }
+  }
 }
 
 match_and_exit($real_target, @ARGV) if $match;
@@ -3495,9 +3700,4 @@ sub apply_fixups {
     }
 }
 
-# Local variables:
-# cperl-indent-level: 4
-# indent-tabs-mode: nil
-# End:
-#
 # ex: set ts=8 sts=4 sw=4 et: