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

5 files changed, 52 insertions, 4 deletions

diff --git a/MANIFEST b/MANIFEST
index eaa74253e1..d87443b466 100644
--- 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 a8038df694..febc4fc8d0 100644
--- 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 ef3d312a46..cfee26c00d 100755
--- 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 9c1dfc0d80..1be1a5bbef 100755
--- 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
index 0000000000..155c5345b6
--- /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";
+