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 (file)
--- 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 (executable)
new mode 100644 (file)
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", <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
@@ -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 (file)
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');