update change#2670 to later version

[p5sagit/p5-mst-13.2.git] / t / op / misc.t

diff --git a/t/op/misc.t b/t/op/misc.t
index 25f566e..78c8bf2 100755 (executable)
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -4,7 +4,7 @@
 # separate executable and can't simply use eval.
 
 chdir 't' if -d 't';
-@INC = "../lib";
+unshift @INC, "../lib";
 $ENV{PERL5LIB} = "../lib";
 
 $|=1;
@@ -36,8 +36,11 @@ for (@prgs){
     $status = $?;
     $results = `$CAT $tmpfile`;
     $results =~ s/\n+$//;
+# bison says 'parse error' instead of 'syntax error',
+# various yaccs may or may not capitalize 'syntax'.
+    $results =~ s/^(syntax|parse) error/syntax error/mig;
     $expected =~ s/\n+$//;
-    if ( $results ne $expected){
+    if ( $results ne $expected ) {
        print STDERR "PROG: $switch\n$prog\n";
        print STDERR "EXPECTED:\n$expected\n";
        print STDERR "GOT:\n$results\n";
@@ -61,7 +64,7 @@ EXPECT
 ########
 $foo=undef; $foo->go;
 EXPECT
-Can't call method "go" without a package or object reference at - line 1.
+Can't call method "go" on an undefined value at - line 1.
 ########
 BEGIN
         {
@@ -336,18 +339,16 @@ sub foo { local $_ = shift; split; @_ }
 @x = foo(' x  y  z ');
 print "you die joe!\n" unless "@x" eq 'x y z';
 ########
-use re 'eval';
 /(?{"{"})/     # Check it outside of eval too
 EXPECT
-Sequence (?{...}) not terminated or not {}-balanced at - line 2, within pattern
-/(?{"{"})/: Sequence (?{...}) not terminated or not {}-balanced at - line 2.
+Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern
+/(?{"{"})/: Sequence (?{...}) not terminated or not {}-balanced at - line 1.
 ########
-use re 'eval';
 /(?{"{"}})/    # Check it outside of eval too
 EXPECT
 Unmatched right bracket at (re_eval 1) line 1, at end of line
 syntax error at (re_eval 1) line 1, near ""{"}"
-Compilation failed in regexp at - line 2.
+Compilation failed in regexp at - line 1.
 ########
 BEGIN { @ARGV = qw(a b c) }
 BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
@@ -410,7 +411,13 @@ destroyed
 package X;
 sub any { bless {} }
 my $f = "FH000"; # just to thwart any future optimisations
-sub afh { select select ++$f; my $r = *{$f}{IO}; delete $X::{$f}; bless $r }
+sub afh {
+    open(++$f, '>&STDOUT') or die;
+    select select $f;
+    my $r = *{$f}{IO};
+    delete $X::{$f};
+    bless $r;
+}
 sub DESTROY { print "destroyed\n" }
 package main;
 $x = any X; # to bump sv_objcount. IO objs aren't counted??
@@ -419,3 +426,56 @@ EXPECT
 destroyed
 destroyed
 ########
+BEGIN {
+  $| = 1;
+  $SIG{__WARN__} = sub {
+    eval { print $_[0] };
+    die "bar\n";
+  };
+  warn "foo\n";
+}
+EXPECT
+foo
+bar
+BEGIN failed--compilation aborted at - line 8.
+########
+package X;
+@ISA='Y';
+sub new {
+    my $class = shift;
+    my $self = { };
+    bless $self, $class;
+    my $init = shift;
+    $self->foo($init);
+    print "new", $init;
+    return $self;
+}
+sub DESTROY {
+    my $self = shift;
+    print "DESTROY", $self->foo;
+}
+package Y;
+sub attribute {
+    my $self = shift;
+    my $var = shift;
+    if (@_ == 0) {
+       return $self->{$var};
+    } elsif (@_ == 1) {
+       $self->{$var} = shift;
+    }
+}
+sub AUTOLOAD {
+    $AUTOLOAD =~ /::([^:]+)$/;
+    my $method = $1;
+    splice @_, 1, 0, $method;
+    goto &attribute;
+}
+package main;
+my $x = X->new(1);
+for (2..3) {
+    my $y = X->new($_);
+    print $y->foo;
+}
+print $x->foo;
+EXPECT
+new1new22DESTROY2new33DESTROY31DESTROY1