update change#2670 to later version
[p5sagit/p5-mst-13.2.git] / t / op / misc.t
index b924f89..78c8bf2 100755 (executable)
@@ -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,11 +36,11 @@ for (@prgs){
     $status = $?;
     $results = `$CAT $tmpfile`;
     $results =~ s/\n+$//;
-# bison says 'parser error' instead of 'syntax error',
+# bison says 'parse error' instead of 'syntax error',
 # various yaccs may or may not capitalize 'syntax'.
-    $results =~ s/^(syntax|parser) error/\L$1 error/i;
+    $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";
@@ -411,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??
@@ -432,3 +438,44 @@ 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