t/op/lop.t See if logical operators work
t/op/magic.t See if magic variables work
t/op/method.t See if method calls work
-t/op/misc.t See if miscellaneous bugs have been fixed
t/op/mkdir.t See if mkdir works
t/op/my.t See if lexical scoping works
t/op/my_stash.t See if my Package works
t/pod/testpods/lib/Pod/Stuff.pm Sample data for find.t
t/README Instructions for regression tests
t/run/exit.t Test perl's exit status.
+t/run/kill_perl.t Tests that kill perl.
t/run/runenv.t Test if perl honors its environment variables.
-t/run/segfault.t Test for old segfaults
t/TEST The regression tester
t/TestInit.pm Preamble library for core tests
taint.c Tainting code
#!./perl
-# NOTE: Please don't add tests to this file unless they *need* to be run in
-# separate executable and can't simply use eval.
+# 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().
+#
+# New tests are added to the bottom. For example.
+#
+# ######## perlbug ID 20020831.001
+# ($a, b) = (1,2)
+# EXPECT
+# Can't modify constant item in list assignment - at line 1
+#
+# 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.
-chdir 't' if -d 't';
-@INC = '../lib';
-$ENV{PERL5LIB} = "../lib";
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use strict;
$|=1;
-undef $/;
-@prgs = split "\n########\n", <DATA>;
+my @prgs = ();
+while(<DATA>) {
+ if(m/^#{8,}\s*(.*)/) {
+ push @prgs, ['', $1];
+ }
+ else {
+ $prgs[-1][0] .= $_;
+ }
+}
print "1..", scalar @prgs, "\n";
-$tmpfile = "misctmp000";
+my $tmpfile = "misctmp000";
1 while -f ++$tmpfile;
END { while($tmpfile && unlink $tmpfile){} }
-$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : (($^O eq 'NetWare') ? 'perl -e "print <>"' : 'cat'));
+my $test = 1;
+foreach my $prog (@prgs) {
+ my($raw_prog, $name) = @$prog;
-for (@prgs){
my $switch;
- if (s/^\s*(-\w.*)//){
+ if ($raw_prog =~ s/^\s*(-\w.*)//){
$switch = $1;
}
- my($prog,$expected) = split(/\nEXPECT\n/, $_);
+
+ my($prog,$expected) = split(/\nEXPECT\n/, $raw_prog);
+
open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";
- $prog =~ s#/dev/null#NL:# if $^O eq 'VMS';
- $prog =~ s#if \(-e _ and -f _ and -r _\)#if (-e _ and -f _)# if $^O eq 'VMS'; # VMS file locking
+
+ # 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 'MSWin32') {
- $results = `.\\perl -I../lib $switch $tmpfile 2>&1`;
+ $results = `.\\perl -I../lib $switch $tmpfile 2>&1`;
}
- elsif ($^O eq 'NetWare') {
- $results = `perl -I../lib $switch $tmpfile 2>&1`;
+ elsif ($^O eq 'NetWare') {
+ $results = `perl -I../lib $switch $tmpfile 2>&1`;
}
else {
- $results = `./perl $switch $tmpfile 2>&1`;
+ $results = `./perl -I../lib $switch $tmpfile 2>&1`;
}
- $status = $?;
+ 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'.
+
+ # bison says 'parse error' instead of 'syntax error',
+ # various yaccs may or may not capitalize 'syntax'.
$results =~ s/^(syntax|parse) error/syntax error/mig;
+
$results =~ s/\n\n/\n/ if $^O eq 'VMS'; # pipes double these sometimes
+
$expected =~ s/\n+$//;
- if ( $results ne $expected ) {
- print STDERR "PROG: $switch\n$prog\n";
- print STDERR "EXPECTED:\n$expected\n";
- print STDERR "GOT:\n$results\n";
- print "not ";
+ my $ok = $results eq $expected;
+
+ unless( $ok ) {
+ print STDERR "# PROG: $switch\n$prog\n";
+ print STDERR "# EXPECTED:\n$expected\n";
+ print STDERR "# GOT:\n$results\n";
}
- print "ok ", ++$i, "\n";
+ printf "%sok %d%s\n", ($ok ? '' : "not "), $test,
+ length $name ? " - $name" : $name;
+ $test++;
}
__END__
-()=()
########
$a = ":="; split /($a)/o, "a:=b:=c"; print "@_"
EXPECT
# keep this last - doesn't seem to work otherwise?
eval "a.b.c.d.e.f;sub"
EXPECT
+
+######## perlbug ID 20010831.001
+($a, b) = (1, 2);
+EXPECT
+Can't modify constant item in list assignment at - line 1, near ");"
+Execution of - aborted due to compilation errors.
+++ /dev/null
-#!./perl
-#
-# Tests for things which have caused segfaults in the past.
-
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
-
-# VMS and Windows need -e "...", most everything else works better with '
-my $quote = $^O =~ /^(VMS|MSWin\d+)$/ ? q{"} : q{'};
-
-my $IsVMS = $^O eq 'VMS';
-
-
-BEGIN {
- if( $^O =~ /^(VMS|MSWin\d+)$/ ) {
- print "1..0 # Skipped: platform temporarily not supported\n";
- exit;
- }
-}
-
-
-# Run some code, check that it has the expected output and exits
-# with the code for a perl syntax error.
-sub chk_segfault {
- my($code, $expect, $name) = @_;
- my $cmd = "$^X -e ";
-
- # I *think* these are the right exit codes for syntax error.
- my $expected_exit = $IsVMS ? 4 : 255;
-
- my $out = `$cmd$quote$code$quote 2>&1`;
-
- is( $? >> 8, $expected_exit, "$name - exit as expected" );
- like( $out, qr/$expect at -e line 1/, ' with the right output' );
-}
-
-use Test::More tests => 2;
-
-chk_segfault('($a, b) = (1, 2)',
- "Can't modify constant item in list assignment",
- 'perlbug ID 20010831.001');
projects / p5sagit/p5-mst-13.2.git / commitdiff