This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: PATCH: Let Test::Harness bail out early (Was: Testing module dependencies)
authorAndreas König <a.koenig@mind.de>
Sat, 9 Dec 2000 17:14:25 +0000 (18:14 +0100)
committerJarkko Hietaniemi <jhi@iki.fi>
Sun, 10 Dec 2000 04:39:19 +0000 (04:39 +0000)
Message-ID: <m3wvd9o9lq.fsf@ak-71.mind.de>

p4raw-id: //depot/perl@8069

MANIFEST
lib/Test/Harness.pm
t/TEST
t/UTEST
t/base/commonsense.t [new file with mode: 0644]

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/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
 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
index a8038df..febc4fc 100644 (file)
@@ -1,3 +1,4 @@
+# -*- Mode: cperl; cperl-indent-level: 4 -*-
 package Test::Harness;
 
 use 5.005_64;
 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;
 
     $columns, @ISA, @EXPORT, @EXPORT_OK);
 $have_devel_corestack = 0;
 
-$VERSION = "1.1605";
+$VERSION = "1.1606";
 
 $ENV{HARNESS_ACTIVE} = 1;
 
 
 $ENV{HARNESS_ACTIVE} = 1;
 
@@ -158,7 +159,9 @@ sub runtests {
                    $next = $this;
                }
                $next = $this + 1;
                    $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 $? ?
        }
        $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);
        }
     }
     my $t_total = timediff(new Benchmark, $t_start);
-    
+
     if ($^O eq 'VMS') {
        if (defined $old5lib) {
            $ENV{PERL5LIB} = $old5lib;
     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
 
     ok
     END
 
-will generate 
+will generate
 
     FAILED tests 1, 3, 6
     Failed 3/6 tests, 50.00% okay
 
     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
 
 
   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.
 =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.
 
 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
 =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;
                    $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;
                    }
                    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;
                    $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;
                    }
                    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
@@ -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";
+