refactor croak.t to be data driven (like warnings.t)

diff --git a/MANIFEST b/MANIFEST
index 0399d69..4d5fcf4 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4973,6 +4973,7 @@ t/lib/Cname.pm                    Test charnames in regexes (op/pat.t)
 t/lib/common.pl                        Helper for lib/{warnings,feature}.t
 t/lib/commonsense.t            See if configuration meets basic needs
 t/lib/compmod.pl               Helper for 1_compile.t
+t/lib/croak/mg                 Test croak calls from mg.c
 t/lib/croak.t                  Test calls to Perl_croak() in the C source.
 t/lib/cygwin.t                 Builtin cygwin function tests
 t/lib/dbmt_common.pl           Common functionality for ?DBM_File tests

diff --git a/t/lib/common.pl b/t/lib/common.pl
index 34a8723..e6a33b2 100644 (file)
--- a/t/lib/common.pl
+++ b/t/lib/common.pl
@@ -1,5 +1,5 @@
-# This code is used by lib/charnames.t, lib/feature.t, lib/subs.t,
-# lib/strict.t and lib/warnings.t
+# This code is used by lib/charnames.t, lib/croak.t, lib/feature.t,
+# lib/subs.t, lib/strict.t and lib/warnings.t
 #
 # On input, $::local_tests is the number of tests in the caller; or
 # 'no_plan' if unknown, in which case it is the caller's responsibility

diff --git a/t/lib/croak.t b/t/lib/croak.t
index 6a9b405..7066b0f 100644 (file)
--- a/t/lib/croak.t
+++ b/t/lib/croak.t
@@ -1,20 +1,7 @@
 #!./perl
-# So far, it seems, there is no place to test all the Perl_croak() calls in the
-# C code. So this is a start. It's likely that it needs refactoring to be data
-# driven. Data driven code exists in various other tests - best plan would be to
-# investigate whether any common code library already exists, and if not,
-# refactor the "donor" test code into a common code library.
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require './test.pl';
-    plan( tests => 1 );
-}
+chdir 't' if -d 't';
+@INC = '../lib';
 
-use strict;
-
-fresh_perl_is(<<'EOF', 'No such hook: _HUNGRY at - line 1.', {}, 'Perl_magic_setsig');
-$SIG{_HUNGRY} = \&mmm_pie;
-warn "Mmm, pie";
-EOF
+$FATAL = 1; # we expect all the tests to croak
+require "../t/lib/common.pl";

diff --git a/t/lib/croak/mg b/t/lib/croak/mg
new file mode 100644 (file)
index 0000000..f136c2c
--- /dev/null
+++ b/t/lib/croak/mg
@@ -0,0 +1,7 @@
+__END__
+# mg.c
+# NAME Perl_magic_setsig
+$SIG{_HUNGRY} = \&mmm_pie;
+warn "Mmm, pie";
+EXPECT
+No such hook: _HUNGRY at - line 2.

diff --git a/t/test.pl b/t/test.pl
index 66d6e07..c5d2845 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -919,6 +919,10 @@ sub run_multiple_progs {
                $reason{$what} = $temp;
            }
        }
+       my $name = '';
+       if ($prog =~ s/^#\s*NAME\s+(.+)\n//m) {
+           $name = $1;
+       }
 
        if ($prog =~ /--FILE--/) {
            my @files = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
@@ -979,6 +983,7 @@ sub run_multiple_progs {
        # any special options? (OPTIONS foo bar zap)
        my $option_regex = 0;
        my $option_random = 0;
+       my $fatal = $FATAL;
        if ($expected =~ s/^OPTIONS? (.+)\n//) {
            foreach my $option (split(' ', $1)) {
                if ($option eq 'regex') { # allow regular expressions
@@ -987,6 +992,9 @@ sub run_multiple_progs {
                elsif ($option eq 'random') { # all lines match, but in any order
                    $option_random = 1;
                }
+               elsif ($option eq 'fatal') { # perl should fail
+                   $fatal = 1;
+               }
                else {
                    die "$0: Unknown OPTION '$option'\n";
                }
@@ -999,28 +1007,36 @@ sub run_multiple_progs {
            print "$results\n" ;
            $ok = 1;
        }
-       elsif ($option_random) {
-           my @got = sort split "\n", $results;
-           my @expected = sort split "\n", $expected;
-
-           $ok = "@got" eq "@expected";
-       }
-       elsif ($option_regex) {
-           $ok = $results =~ /^$expected/;
-       }
-       elsif ($prefix) {
-           $ok = $results =~ /^\Q$expected/;
-       }
        else {
-           $ok = $results eq $expected;
+           if ($option_random) {
+               my @got = sort split "\n", $results;
+               my @expected = sort split "\n", $expected;
+
+               $ok = "@got" eq "@expected";
+           }
+           elsif ($option_regex) {
+               $ok = $results =~ /^$expected/;
+           }
+           elsif ($prefix) {
+               $ok = $results =~ /^\Q$expected/;
+           }
+           else {
+               $ok = $results eq $expected;
+           }
+
+           if ($ok && $fatal && !($status >> 8)) {
+               $ok = 0;
+           }
        }
 
        local $::TODO = $reason{todo};
 
        unless ($ok) {
            my $err_line = "PROG: $switch\n$prog\n" .
-                          "EXPECTED:\n$expected\n" .
-                          "GOT:\n$results\n";
+                          "EXPECTED:\n$expected\n";
+           $err_line   .= "EXIT STATUS: != 0\n" if $fatal;
+           $err_line   .= "GOT:\n$results\n";
+           $err_line   .= "EXIT STATUS: " . ($status >> 8) . "\n" if $fatal;
            if ($::TODO) {
                $err_line =~ s/^/# /mg;
                print $err_line;  # Harness can't filter it out from STDERR.
@@ -1030,7 +1046,7 @@ sub run_multiple_progs {
            }
        }
 
-       ok($ok);
+       ok($ok, $name);
 
        foreach (@temps) {
            unlink $_ if $_;