Permalink
Browse files

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

  • Loading branch information...
1 parent 9d3432a commit 59e3875574a8b5ab5b5ec16210aa9fbbdc3919cb @tonycoz tonycoz committed Nov 26, 2011
Showing with 46 additions and 35 deletions.
  1. +1 −0 MANIFEST
  2. +2 −2 t/lib/common.pl
  3. +4 −17 t/lib/croak.t
  4. +7 −0 t/lib/croak/mg
  5. +32 −16 t/test.pl
View
1 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
View
4 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
View
21 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";
View
7 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.
View
48 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 $_;

0 comments on commit 59e3875

Please sign in to comment.