Re: PATCH: Let Test::Harness bail out early (Was: Testing module dependencies)

Message-ID: <m3wvd9o9lq.fsf@ak-71.mind.de>

p4raw-id: //depot/perl@8069

diff --git a/MANIFEST b/MANIFEST
index eaa7425..d87443b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1301,6 +1301,7 @@ sv.h                      Scalar value header
 t/README               Instructions for regression tests
 t/TEST                 The regression tester
 t/UTEST                        Run regression tests with -Mutf8
+t/base/commonsense.t   See if configuration meets basic needs
 t/base/cond.t          See if conditionals work
 t/base/if.t            See if if works
 t/base/lex.t           See if lexical items work

diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index a8038df..febc4fc 100644 (file)
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -1,3 +1,4 @@
+# -*- Mode: cperl; cperl-indent-level: 4 -*-
 package Test::Harness;
 
 use 5.005_64;
@@ -11,7 +12,7 @@ our($VERSION, $verbose, $switches, $have_devel_corestack, $curtest,
     $columns, @ISA, @EXPORT, @EXPORT_OK);
 $have_devel_corestack = 0;
 
-$VERSION = "1.1605";
+$VERSION = "1.1606";
 
 $ENV{HARNESS_ACTIVE} = 1;
 
@@ -158,7 +159,9 @@ sub runtests {
                    $next = $this;
                }
                $next = $this + 1;
-           }
+           } elsif (/^Bail out!\s*(.*)/i) { # magic words
+                die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
+            }
        }
        $fh->close; # must close to reap child resource values
        my $wstatus = $ignore_exitcode ? 0 : $?;        # Can trust $? ?
@@ -259,7 +262,7 @@ sub runtests {
        }
     }
     my $t_total = timediff(new Benchmark, $t_start);
-    
+
     if ($^O eq 'VMS') {
        if (defined $old5lib) {
            $ENV{PERL5LIB} = $old5lib;
@@ -462,7 +465,7 @@ script supplies test numbers again. So the following test script
     ok
     END
 
-will generate 
+will generate
 
     FAILED tests 1, 3, 6
     Failed 3/6 tests, 50.00% okay
@@ -488,6 +491,15 @@ C<1..0> line emitted if the test is skipped completely:
 
   1..0 # Skipped: no leverage found
 
+As an emergency measure, a test script can decide that further tests
+are useless (e.g. missing dependencies) and testing should stop
+immediately. In that case the test script prints the magic words
+
+  Bail out!
+
+to standard output. Any message after these words will be displayed by
+C<Test::Harness> as the reason why testing is stopped.
+
 =head1 EXPORT
 
 C<&runtests> is exported by Test::Harness per default.
@@ -518,6 +530,11 @@ printed in a message similar to the above.
 If not all tests were successful, the script dies with one of the
 above messages.
 
+=item C<FAILED--Further testing stopped%s>
+
+If a single subtest decides that further testing will not make sense,
+the script dies with this message.
+
 =back
 
 =head1 ENVIRONMENT

diff --git a/t/TEST b/t/TEST
index ef3d312..cfee26c 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -114,6 +114,9 @@ EOT
                    $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
                    if (/^ok (\d+)(\s*#.*)?$/ && $1 == $next) {
                        $next = $next + 1;
+                    }
+                    elsif (/^Bail out!\s*(.*)/i) { # magic words
+                        die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
                    }
                    else {
                        $ok = 0;

diff --git a/t/UTEST b/t/UTEST
index 9c1dfc0..1be1a5b 100755 (executable)
--- a/t/UTEST
+++ b/t/UTEST
@@ -127,6 +127,9 @@ EOT
                    $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
                    if (/^ok (\d+)(\s*#.*)?$/ && $1 == $next) {
                        $next = $next + 1;
+                    }
+                    elsif (/^Bail out!\s*(.*)/i) { # magic words
+                        die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
                    }
                    else {
                        $ok = 0;

diff --git a/t/base/commonsense.t b/t/base/commonsense.t
new file mode 100644 (file)
index 0000000..155c534
--- /dev/null
+++ b/t/base/commonsense.t
@@ -0,0 +1,24 @@
+#!./perl
+
+chdir 't' if -d 't';
+@INC = '../lib';
+require Config; import Config;
+if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){
+  print "Bail out! Perl configured without DB_File or [A-Z]DBM_File\n";
+  exit 0;
+}
+if (($Config{'extensions'} !~ /\bFcntl\b/) ){
+  print "Bail out! Perl configured without Fcntl module\n";
+  exit 0;
+}
+if (($Config{'extensions'} !~ /\bIO\b/) ){
+  print "Bail out! Perl configured without IO module\n";
+  exit 0;
+}
+if (($Config{'extensions'} !~ /\bFile\/Glob\b/) ){
+  print "Bail out! Perl configured without File::Glob module\n";
+  exit 0;
+}
+
+print "1..1\nok 1\n";
+