As long ago promised, here's a patch to pull the logic out of
t/run/kill_perl.t and make it into a t/test.pl function.
This means its no longer necessary to pile segfault checks into
t/run/kill_perl.t. They can be placed in the appropriate test file
like so:
kill_perl(PROG, EXPECT, {}, 'segfault in 5.6.1 within peep()' );
@a = (1..9);
@b = sort { @c = sort { @d = sort { 0 } @a; @d; } @a; } @a;
print join '', @a, \n;
PROG
123456789
EXPECT
Give or take the fancy here-doc idiom.
The name of the function and order of arguments are all up for
discussion.
Next step is to move the existing tests in kill_perl.t into their
rightful files.
PS There was also a bug in runperl(). All switches were being lost.
--- t/test.pl 2002/01/11 08:41:48 1.1
+++ t/test.pl 2002/01/11 09:17:19
@@ -280,7 +280,7 @@
my %args = @_;
my $runperl = $^X;
if ($args{switches}) {
- _quote_args(\$runperl, $args{switches});
+ _quote_args(\$runperl, [$args{switches}]);
}
unless ($args{nolib}) {
if ($is_macos) {
@@ -390,4 +390,66 @@
print STDERR # Couldn't unlink '$file': $!\n if -f $file;
}
}
+
+
+my $tmpfile = misctmp000;
+1 while -f ++$tmpfile;
+END { unlink_all $tmpfile }
+
+sub kill_perl {
+my($prog, $expected, $runperl_args, $name) = @_;
+
+$runperl_args ||= {};
+$runperl_args-{progfile} = $tmpfile;
+$runperl_args-{stderr} = 1;
+
+open TEST, $tmpfile or die Cannot open $tmpfile: $!;
+
+# VMS adjustments
+if( $^O eq 'VMS' ) {
+$prog =~ s#/dev/null#NL:#;
+
+# VMS file locking
+$prog =~ s{if \(-e _ and -f _ and -r _\)}
+ {if (-e _ and -f _)}
+}
+
+print TEST $prog, \n;
+close TEST or die Cannot close $tmpfile: $!;
+
+my $results = runperl(%$runperl_args);
+my $status = $?;
+
+# Clean up the results into something a bit more predictable.
+$results =~ s/\n+$//;
+$results =~ s/at\s+misctmp\d+\s+line/at - line/g;
+$results =~ s/of\s+misctmp\d+\s+aborted/of - aborted/g;
+
+# bison says 'parse error' instead of 'syntax error',
+# various yaccs may or may not capitalize 'syntax'.
+$results =~ s/^(syntax|parse) error/syntax error/mig;
+
+if ($^O eq 'VMS') {
+# some tests will trigger VMS messages that won't be expected
+$results =~ s/\n?%[A-Z]+-[SIWEF]-[A-Z]+,.*//;
+
+# pipes double these sometimes
+$results =~ s/\n\n/\n/g;
+}
+
+$expected =~ s/\n+$//;
+
+my $pass = $results eq $expected;
+unless ($pass) {
+print STDERR # PROG: $switch\n$prog\n;
+print STDERR # EXPECTED:\n$expected\n;
+print STDERR # GOT:\n$results\n;
+print STDERR # STATUS: $status\n;
+}
+
+($name) = $prog =~ /^(.{1,35})/ unless $name;
+
+_ok($pass, _where(), kill_perl - $name);
+}
+
1;
--- t/run/kill_perl.t 2002/01/11 08:42:45 1.1
+++ t/run/kill_perl.t 2002/01/11 09:24:36
@@ -1,5 +1,9 @@
#!./perl
+# ** DO NOT ADD ANY MORE TESTS HERE **
+# Instead, put the test in the appropriate test file and use the
+# kill_perl() function in t/test.pl.
+
# This is for tests that will normally cause segfaults, and other nasty
# errors that might kill the interpreter and for some reason you can't
# use an eval().
@@ -14,10 +18,6 @@
# to test that the code ($a, b) = (1,2) causes the appropriate syntax
# error, rather than just segfaulting as reported in perlbug ID
# 20020831.001
-#
-#
-# NOTE: Please don't add tests to this file unless they *need* to be
-# run in separate executable and can't simply use eval.
BEGIN {
chdir 't' if -d 't';
@@ -40,13 +40,8 @@
$prgs[-1][0] .= $_;
}
}
-print 1.., scalar @prgs, \n;
-
-my $tmpfile = misctmp000;
-1 while -f ++$tmpfile;
-END { while($tmpfile unlink $tmpfile){} }
+plan tests = scalar @prgs;
-my $test = 1;
foreach my $prog (@prgs) {
my($raw_prog, $name) = @$prog;
@@ -57,57 +52,7 @@
my($prog,$expected) = split(/\nEXPECT\n/, $raw_prog);
-open TEST, $tmpfile or die Cannot open $tmpfile: $!;
-
-# VMS adjustments
-if( $^O eq 'VMS' ) {
-$prog =~ s#/dev/null#NL:#;
-
-# VMS file locking
-$prog =~ s{if \(-e _ and -f _ and -r _\)}
- {if (-e _ and -f _)}
-}
-
-print TEST $prog, \n;
-close TEST or die Cannot close $tmpfile: $!;
-
-my $results;
-if ($^O eq 'MacOS') {
-$results = `$Perl -I::lib -MMac::err=unix $switch $tmpfile`;
-}
-else {
-$results = `$Perl -I../lib $switch $tmpfile 21`;
-}
-my $status = $?;
-
-# Clean up the results into something a bit more predictable.
-$results =~ s/\n+$//;
-$results =~ s/at\s+misctmp\d+\s+line/at - line/g;
-$results =~ s/of\s+misctmp\d+\s+aborted/of - aborted/g;
-
-# bison says 'parse error' instead of 'syntax error',
-# various yaccs may or may not capitalize 'syntax'.
-$results =~ s/^(syntax|parse) error/syntax error/mig;
-
-if ($^O eq 'VMS') {
-
