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

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

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

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";

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.

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 $_;