From: Michael G. Schwern Date: Sat, 1 Sep 2001 20:18:58 +0000 (-0400) Subject: rm t/run/segfault.t; mv t/op/misc.t t/run/kill_perl.t X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c9beb3f55a1e5316151688ffb6caa12ed94c8f37;p=p5sagit%2Fp5-mst-13.2.git rm t/run/segfault.t; mv t/op/misc.t t/run/kill_perl.t Message-ID: <20010901201858.X606@blackrider> +MANIFEST Fix p4raw-id: //depot/perl@11828 --- diff --git a/MANIFEST b/MANIFEST index aa28762..3ed233a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2048,7 +2048,6 @@ t/op/loopctl.t See if next/last/redo work 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 @@ -2139,8 +2138,8 @@ t/pod/testpchk.pl Module to test Pod::Checker for a given file 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 diff --git a/t/op/misc.t b/t/run/kill_perl.t old mode 100755 new mode 100644 similarity index 86% rename from t/op/misc.t rename to t/run/kill_perl.t index 3cfb667..2b4a5a6 --- a/t/op/misc.t +++ b/t/run/kill_perl.t @@ -1,66 +1,110 @@ #!./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", ; +my @prgs = (); +while() { + 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 @@ -739,3 +783,9 @@ 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. diff --git a/t/run/segfault.t b/t/run/segfault.t deleted file mode 100644 index e3bd8b6..0000000 --- a/t/run/segfault.t +++ /dev/null @@ -1,43 +0,0 @@ -#!./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');