[perl5.git] / t / op / method.t

#!./perl -w

#
# test method calls and autoloading.
#

BEGIN {
    chdir 't' if -d 't';
    @INC = qw(. ../lib);
    require "test.pl";
}

use strict;
no warnings 'once';

plan(tests => 79);

@A::ISA = 'B';
@B::ISA = 'C';

sub C::d {"C::d"}
sub D::d {"D::d"}

# First, some basic checks of method-calling syntax:
my $obj = bless [], "Pack";
sub Pack::method { shift; join(",", "method", @_) }
my $mname = "method";

is(Pack->method("a","b","c"), "method,a,b,c");
is(Pack->$mname("a","b","c"), "method,a,b,c");
is(method Pack ("a","b","c"), "method,a,b,c");
is((method Pack "a","b","c"), "method,a,b,c");

is(Pack->method(), "method");
is(Pack->$mname(), "method");
is(method Pack (), "method");
is(Pack->method, "method");
is(Pack->$mname, "method");
is(method Pack, "method");

is($obj->method("a","b","c"), "method,a,b,c");
is($obj->$mname("a","b","c"), "method,a,b,c");
is((method $obj ("a","b","c")), "method,a,b,c");
is((method $obj "a","b","c"), "method,a,b,c");

is($obj->method(0), "method,0");
is($obj->method(1), "method,1");

is($obj->method(), "method");
is($obj->$mname(), "method");
is((method $obj ()), "method");
is($obj->method, "method");
is($obj->$mname, "method");
is(method $obj, "method");

is( A->d, "C::d");		# Update hash table;

*B::d = \&D::d;			# Import now.
is(A->d, "D::d");		# Update hash table;

{
    local @A::ISA = qw(C);	# Update hash table with split() assignment
    is(A->d, "C::d");
    $#A::ISA = -1;
    is(eval { A->d } || "fail", "fail");
}
is(A->d, "D::d");

{
    local *B::d;
    eval 'sub B::d {"B::d1"}';	# Import now.
    is(A->d, "B::d1");	# Update hash table;
    undef &B::d;
    is((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1);
}

is(A->d, "D::d");		# Back to previous state

eval 'no warnings "redefine"; sub B::d {"B::d2"}';	# Import now.
is(A->d, "B::d2");		# Update hash table;

# What follows is hardly guarantied to work, since the names in scripts
# are already linked to "pruned" globs. Say, `undef &B::d' if it were
# after `delete $B::{d}; sub B::d {}' would reach an old subroutine.

undef &B::d;
delete $B::{d};
is(A->d, "C::d");		# Update hash table;

eval 'sub B::d {"B::d3"}';	# Import now.
is(A->d, "B::d3");		# Update hash table;

delete $B::{d};
*dummy::dummy = sub {};		# Mark as updated
is(A->d, "C::d");

eval 'sub B::d {"B::d4"}';	# Import now.
is(A->d, "B::d4");		# Update hash table;

delete $B::{d};			# Should work without any help too
is(A->d, "C::d");

{
    local *C::d;
    is(eval { A->d } || "nope", "nope");
}
is(A->d, "C::d");

*A::x = *A::d;
A->d;
is(eval { A->x } || "nope", "nope", 'cache should not follow synonyms');

my $counter;

eval <<'EOF';
sub C::e;
BEGIN { *B::e = \&C::e }	# Shouldn't prevent AUTOLOAD in original pkg
sub Y::f;
$counter = 0;

@X::ISA = 'Y';
@Y::ISA = 'B';

sub B::AUTOLOAD {
  my $c = ++$counter;
  my $method = $B::AUTOLOAD; 
  my $msg = "B: In $method, $c";
  eval "sub $method { \$msg }";
  goto &$method;
}
sub C::AUTOLOAD {
  my $c = ++$counter;
  my $method = $C::AUTOLOAD; 
  my $msg = "C: In $method, $c";
  eval "sub $method { \$msg }";
  goto &$method;
}
EOF

is(A->e(), "C: In C::e, 1");	# We get a correct autoload
is(A->e(), "C: In C::e, 1");	# Which sticks

is(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top
is(A->ee(), "B: In A::ee, 2"); # Which sticks

is(Y->f(), "B: In Y::f, 3");	# We vivify a correct method
is(Y->f(), "B: In Y::f, 3");	# Which sticks

# This test is not intended to be reasonable. It is here just to let you
# know that you broke some old construction. Feel free to rewrite the test
# if your patch breaks it.

{
no warnings 'redefine';
*B::AUTOLOAD = sub {
  use warnings;
  my $c = ++$counter;
  my $method = $::AUTOLOAD; 
  no strict 'refs';
  *$::AUTOLOAD = sub { "new B: In $method, $c" };
  goto &$::AUTOLOAD;
};
}

is(A->eee(), "new B: In A::eee, 4");	# We get a correct $autoload
is(A->eee(), "new B: In A::eee, 4");	# Which sticks

{
    no strict 'refs';
    # this test added due to bug discovery (in 5.004_04, fb73857aa0bfa8ed)
    is(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
}

# test that failed subroutine calls don't affect method calls
{
    package A1;
    sub foo { "foo" }
    package A2;
    @A2::ISA = 'A1';
    package main;
    is(A2->foo(), "foo");
    is(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1);
    is(A2->foo(), "foo");
}

## This test was totally misguided.  It passed before only because the
## code to determine if a package was loaded used to look for the hash
## %Foo::Bar instead of the package Foo::Bar:: -- and Config.pm just
## happens to export %Config.
#  {
#      is(do { use Config; eval 'Config->foo()';
#  	      $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1);
#      is(do { use Config; eval '$d = bless {}, "Config"; $d->foo()';
#  	      $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1);
#  }

# test error messages if method loading fails
my $e;

eval '$e = bless {}, "E::A"; E::A->foo()';
like ($@, qr/^\QCan't locate object method "foo" via package "E::A" at/);
eval '$e = bless {}, "E::B"; $e->foo()';  
like ($@, qr/^\QCan't locate object method "foo" via package "E::B" at/);
eval 'E::C->foo()';
like ($@, qr/^\QCan't locate object method "foo" via package "E::C" (perhaps /);

eval 'UNIVERSAL->E::D::foo()';
like ($@, qr/^\QCan't locate object method "foo" via package "E::D" (perhaps /);
eval 'my $e = bless {}, "UNIVERSAL"; $e->E::E::foo()';
like ($@, qr/^\QCan't locate object method "foo" via package "E::E" (perhaps /);

$e = bless {}, "E::F";  # force package to exist
eval 'UNIVERSAL->E::F::foo()';
like ($@, qr/^\QCan't locate object method "foo" via package "E::F" at/);
eval '$e = bless {}, "UNIVERSAL"; $e->E::F::foo()';
like ($@, qr/^\QCan't locate object method "foo" via package "E::F" at/);

# TODO: we need some tests for the SUPER:: pseudoclass

# failed method call or UNIVERSAL::can() should not autovivify packages
is( $::{"Foo::"} || "none", "none");  # sanity check 1
is( $::{"Foo::"} || "none", "none");  # sanity check 2

is( UNIVERSAL::can("Foo", "boogie") ? "yes":"no", "no" );
is( $::{"Foo::"} || "none", "none");  # still missing?

is( Foo->UNIVERSAL::can("boogie")   ? "yes":"no", "no" );
is( $::{"Foo::"} || "none", "none");  # still missing?

is( Foo->can("boogie")              ? "yes":"no", "no" );
is( $::{"Foo::"} || "none", "none");  # still missing?

is( eval 'Foo->boogie(); 1'         ? "yes":"no", "no" );
is( $::{"Foo::"} || "none", "none");  # still missing?

is(do { eval 'Foo->boogie()';
	  $@ =~ /^\QCan't locate object method "boogie" via package "Foo" (perhaps / ? 1 : $@}, 1);

eval 'sub Foo::boogie { "yes, sir!" }';
is( $::{"Foo::"} ? "ok" : "none", "ok");  # should exist now
is( Foo->boogie(), "yes, sir!");

# TODO: universal.t should test NoSuchPackage->isa()/can()

# This is actually testing parsing of indirect objects and undefined subs
#   print foo("bar") where foo does not exist is not an indirect object.
#   print foo "bar"  where foo does not exist is an indirect object.
eval 'sub AUTOLOAD { "ok ", shift, "\n"; }';
ok(1);

# Bug ID 20010902.002
is(
    eval q[
	my $x = 'x'; # Lexical or package variable, 5.6.1 panics.
	sub Foo::x : lvalue { $x }
	Foo->$x = 'ok';
    ] || $@, 'ok'
);

# An autoloaded, inherited DESTROY may be invoked differently than normal
# methods, and has been known to give rise to spurious warnings
# eg <200203121600.QAA11064@gizmo.fdgroup.co.uk>

{
    use warnings;
    my $w = '';
    local $SIG{__WARN__} = sub { $w = $_[0] };

    sub AutoDest::Base::AUTOLOAD {}
    @AutoDest::ISA = qw(AutoDest::Base);
    { my $x = bless {}, 'AutoDest'; }
    $w =~ s/\n//g;
    is($w, '');
}

# [ID 20020305.025] PACKAGE::SUPER doesn't work anymore

package main;
our @X;
package Amajor;
sub test {
    push @main::X, 'Amajor', @_;
}
package Bminor;
use base qw(Amajor);
package main;
sub Bminor::test {
    $_[0]->Bminor::SUPER::test('x', 'y');
    push @main::X, 'Bminor', @_;
}
Bminor->test('y', 'z');
is("@X", "Amajor Bminor x y Bminor Bminor y z");

package main;
for my $meth (['Bar', 'Foo::Bar'],
	      ['SUPER::Bar', 'main::SUPER::Bar'],
	      ['Xyz::SUPER::Bar', 'Xyz::SUPER::Bar'])
{
    fresh_perl_is(<<EOT,
package UNIVERSAL; sub AUTOLOAD { my \$c = shift; print "\$c \$AUTOLOAD\\n" }
package Xyz;
package main; Foo->$meth->[0]();
EOT
	"Foo $meth->[1]",
	{ switches => [ '-w' ] },
	"check if UNIVERSAL::AUTOLOAD works",
    );
}

# Test for #71952: crash when looking for a nonexistent destructor
# Regression introduced by fbb3ee5af3d4
{
    fresh_perl_is(<<'EOT',
sub M::DESTROY; bless {}, "M" ; print "survived\n";
EOT
    "survived",
    {},
	"no crash with a declared but missing DESTROY method"
    );
}
Commit	Line	Data
9bfdb36e	1	#!./perl -w
92d69e20 IZ	2
	3	#
	4	# test method calls and autoloading.
	5	#
	6
4755096e GS	7	BEGIN {
4755096e GS	8	chdir 't' if -d 't';
6dc4e5ce JH	9	@INC = qw(. ../lib);
6dc4e5ce JH	10	require "test.pl";
4755096e GS	11	}
4755096e GS	12
9bfdb36e NC	13	use strict;
	14	no warnings 'once';
	15
	16	plan(tests => 79);
92d69e20 IZ	17
	18	@A::ISA = 'B';
	19	@B::ISA = 'C';
	20
	21	sub C::d {"C::d"}
	22	sub D::d {"D::d"}
	23
567ce7b1	24	# First, some basic checks of method-calling syntax:
9bfdb36e	25	my $obj = bless [], "Pack";
567ce7b1	26	sub Pack::method { shift; join(",", "method", @_) }
9bfdb36e	27	my $mname = "method";
567ce7b1	28
6dc4e5ce JH	29	is(Pack->method("a","b","c"), "method,a,b,c");
	30	is(Pack->$mname("a","b","c"), "method,a,b,c");
	31	is(method Pack ("a","b","c"), "method,a,b,c");
	32	is((method Pack "a","b","c"), "method,a,b,c");
567ce7b1	33
6dc4e5ce JH	34	is(Pack->method(), "method");
	35	is(Pack->$mname(), "method");
	36	is(method Pack (), "method");
	37	is(Pack->method, "method");
	38	is(Pack->$mname, "method");
	39	is(method Pack, "method");
567ce7b1	40
6dc4e5ce JH	41	is($obj->method("a","b","c"), "method,a,b,c");
	42	is($obj->$mname("a","b","c"), "method,a,b,c");
	43	is((method $obj ("a","b","c")), "method,a,b,c");
	44	is((method $obj "a","b","c"), "method,a,b,c");
145eb477	45
6dc4e5ce JH	46	is($obj->method(0), "method,0");
6dc4e5ce JH	47	is($obj->method(1), "method,1");
567ce7b1	48
6dc4e5ce JH	49	is($obj->method(), "method");
	50	is($obj->$mname(), "method");
	51	is((method $obj ()), "method");
	52	is($obj->method, "method");
	53	is($obj->$mname, "method");
	54	is(method $obj, "method");
567ce7b1	55
6dc4e5ce	56	is( A->d, "C::d"); # Update hash table;
92d69e20 IZ	57
92d69e20 IZ	58	*B::d = \&D::d; # Import now.
6dc4e5ce	59	is(A->d, "D::d"); # Update hash table;
92d69e20	60
44a8e56a	61	{
fb73857a	62	local @A::ISA = qw(C); # Update hash table with split() assignment
6dc4e5ce	63	is(A->d, "C::d");
fb73857a	64	$#A::ISA = -1;
6dc4e5ce	65	is(eval { A->d } \|\| "fail", "fail");
fb73857a	66	}
6dc4e5ce	67	is(A->d, "D::d");
fb73857a	68
fb73857a	69	{
44a8e56a	70	local *B::d;
44a8e56a	71	eval 'sub B::d {"B::d1"}'; # Import now.
6dc4e5ce	72	is(A->d, "B::d1"); # Update hash table;
44a8e56a	73	undef &B::d;
6dc4e5ce	74	is((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1);
44a8e56a	75	}
92d69e20	76
6dc4e5ce	77	is(A->d, "D::d"); # Back to previous state
92d69e20	78
9bfdb36e	79	eval 'no warnings "redefine"; sub B::d {"B::d2"}'; # Import now.
6dc4e5ce	80	is(A->d, "B::d2"); # Update hash table;
92d69e20 IZ	81
	82	# What follows is hardly guarantied to work, since the names in scripts
	83	# are already linked to "pruned" globs. Say, `undef &B::d' if it were
	84	# after `delete $B::{d}; sub B::d {}' would reach an old subroutine.
	85
	86	undef &B::d;
	87	delete $B::{d};
6dc4e5ce	88	is(A->d, "C::d"); # Update hash table;
92d69e20 IZ	89
92d69e20 IZ	90	eval 'sub B::d {"B::d3"}'; # Import now.
6dc4e5ce	91	is(A->d, "B::d3"); # Update hash table;
92d69e20 IZ	92
	93	delete $B::{d};
	94	*dummy::dummy = sub {}; # Mark as updated
6dc4e5ce	95	is(A->d, "C::d");
92d69e20 IZ	96
92d69e20 IZ	97	eval 'sub B::d {"B::d4"}'; # Import now.
6dc4e5ce	98	is(A->d, "B::d4"); # Update hash table;
92d69e20 IZ	99
92d69e20 IZ	100	delete $B::{d}; # Should work without any help too
6dc4e5ce	101	is(A->d, "C::d");
92d69e20	102
fae75791 CS	103	{
fae75791 CS	104	local *C::d;
6dc4e5ce	105	is(eval { A->d } \|\| "nope", "nope");
fae75791	106	}
6dc4e5ce	107	is(A->d, "C::d");
fae75791	108
9bfdb36e	109	A::x = A::d;
44a8e56a	110	A->d;
9bfdb36e NC	111	is(eval { A->x } \|\| "nope", "nope", 'cache should not follow synonyms');
	112
	113	my $counter;
44a8e56a	114
92d69e20 IZ	115	eval <<'EOF';
92d69e20 IZ	116	sub C::e;
09280a33	117	BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg
92d69e20 IZ	118	sub Y::f;
	119	$counter = 0;
	120
54310121	121	@X::ISA = 'Y';
dc848c6f	122	@Y::ISA = 'B';
92d69e20 IZ	123
	124	sub B::AUTOLOAD {
	125	my $c = ++$counter;
	126	my $method = $B::AUTOLOAD;
09280a33 CS	127	my $msg = "B: In $method, $c";
	128	eval "sub $method { \$msg }";
	129	goto &$method;
92d69e20 IZ	130	}
	131	sub C::AUTOLOAD {
	132	my $c = ++$counter;
	133	my $method = $C::AUTOLOAD;
09280a33 CS	134	my $msg = "C: In $method, $c";
	135	eval "sub $method { \$msg }";
	136	goto &$method;
92d69e20 IZ	137	}
	138	EOF
	139
6dc4e5ce JH	140	is(A->e(), "C: In C::e, 1"); # We get a correct autoload
6dc4e5ce JH	141	is(A->e(), "C: In C::e, 1"); # Which sticks
92d69e20	142
6dc4e5ce JH	143	is(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top
6dc4e5ce JH	144	is(A->ee(), "B: In A::ee, 2"); # Which sticks
92d69e20	145
6dc4e5ce JH	146	is(Y->f(), "B: In Y::f, 3"); # We vivify a correct method
6dc4e5ce JH	147	is(Y->f(), "B: In Y::f, 3"); # Which sticks
92d69e20 IZ	148
	149	# This test is not intended to be reasonable. It is here just to let you
	150	# know that you broke some old construction. Feel free to rewrite the test
	151	# if your patch breaks it.
	152
9bfdb36e NC	153	{
9bfdb36e NC	154	no warnings 'redefine';
92d69e20	155	*B::AUTOLOAD = sub {
9bfdb36e	156	use warnings;
92d69e20	157	my $c = ++$counter;
9bfdb36e NC	158	my $method = $::AUTOLOAD;
	159	no strict 'refs';
	160	*$::AUTOLOAD = sub { "new B: In $method, $c" };
	161	goto &$::AUTOLOAD;
92d69e20	162	};
9bfdb36e	163	}
92d69e20	164
6dc4e5ce JH	165	is(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload
6dc4e5ce JH	166	is(A->eee(), "new B: In A::eee, 4"); # Which sticks
fb73857a	167
9bfdb36e NC	168	{
	169	no strict 'refs';
	170	# this test added due to bug discovery (in 5.004_04, fb73857aa0bfa8ed)
	171	is(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
	172	}
f6ec51f7 GS	173
	174	# test that failed subroutine calls don't affect method calls
	175	{
	176	package A1;
	177	sub foo { "foo" }
	178	package A2;
9bfdb36e	179	@A2::ISA = 'A1';
f6ec51f7	180	package main;
6dc4e5ce JH	181	is(A2->foo(), "foo");
	182	is(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1);
	183	is(A2->foo(), "foo");
f6ec51f7	184	}
c1899e02	185
af09ea45 IK	186	## This test was totally misguided. It passed before only because the
	187	## code to determine if a package was loaded used to look for the hash
	188	## %Foo::Bar instead of the package Foo::Bar:: -- and Config.pm just
	189	## happens to export %Config.
	190	# {
6dc4e5ce	191	# is(do { use Config; eval 'Config->foo()';
af09ea45	192	# $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1);
6dc4e5ce	193	# is(do { use Config; eval '$d = bless {}, "Config"; $d->foo()';
af09ea45 IK	194	# $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1);
	195	# }
	196
af09ea45	197	# test error messages if method loading fails
9bfdb36e NC	198	my $e;
9bfdb36e NC	199
2f907243 NC	200	eval '$e = bless {}, "E::A"; E::A->foo()';
	201	like ($@, qr/^\QCan't locate object method "foo" via package "E::A" at/);
	202	eval '$e = bless {}, "E::B"; $e->foo()';
	203	like ($@, qr/^\QCan't locate object method "foo" via package "E::B" at/);
	204	eval 'E::C->foo()';
	205	like ($@, qr/^\QCan't locate object method "foo" via package "E::C" (perhaps /);
	206
	207	eval 'UNIVERSAL->E::D::foo()';
	208	like ($@, qr/^\QCan't locate object method "foo" via package "E::D" (perhaps /);
9bfdb36e	209	eval 'my $e = bless {}, "UNIVERSAL"; $e->E::E::foo()';
2f907243	210	like ($@, qr/^\QCan't locate object method "foo" via package "E::E" (perhaps /);
af09ea45 IK	211
af09ea45 IK	212	$e = bless {}, "E::F"; # force package to exist
2f907243 NC	213	eval 'UNIVERSAL->E::F::foo()';
	214	like ($@, qr/^\QCan't locate object method "foo" via package "E::F" at/);
	215	eval '$e = bless {}, "UNIVERSAL"; $e->E::F::foo()';
	216	like ($@, qr/^\QCan't locate object method "foo" via package "E::F" at/);
af09ea45 IK	217
	218	# TODO: we need some tests for the SUPER:: pseudoclass
	219
	220	# failed method call or UNIVERSAL::can() should not autovivify packages
6dc4e5ce JH	221	is( $::{"Foo::"} \|\| "none", "none"); # sanity check 1
6dc4e5ce JH	222	is( $::{"Foo::"} \|\| "none", "none"); # sanity check 2
c1899e02	223
6dc4e5ce JH	224	is( UNIVERSAL::can("Foo", "boogie") ? "yes":"no", "no" );
6dc4e5ce JH	225	is( $::{"Foo::"} \|\| "none", "none"); # still missing?
af09ea45	226
6dc4e5ce JH	227	is( Foo->UNIVERSAL::can("boogie") ? "yes":"no", "no" );
6dc4e5ce JH	228	is( $::{"Foo::"} \|\| "none", "none"); # still missing?
af09ea45	229
6dc4e5ce JH	230	is( Foo->can("boogie") ? "yes":"no", "no" );
6dc4e5ce JH	231	is( $::{"Foo::"} \|\| "none", "none"); # still missing?
af09ea45	232
6dc4e5ce JH	233	is( eval 'Foo->boogie(); 1' ? "yes":"no", "no" );
6dc4e5ce JH	234	is( $::{"Foo::"} \|\| "none", "none"); # still missing?
af09ea45	235
6dc4e5ce	236	is(do { eval 'Foo->boogie()';
af09ea45 IK	237	$@ =~ /^\QCan't locate object method "boogie" via package "Foo" (perhaps / ? 1 : $@}, 1);
	238
	239	eval 'sub Foo::boogie { "yes, sir!" }';
6dc4e5ce JH	240	is( $::{"Foo::"} ? "ok" : "none", "ok"); # should exist now
6dc4e5ce JH	241	is( Foo->boogie(), "yes, sir!");
af09ea45 IK	242
af09ea45 IK	243	# TODO: universal.t should test NoSuchPackage->isa()/can()
c1899e02	244
f0670693 SC	245	# This is actually testing parsing of indirect objects and undefined subs
	246	# print foo("bar") where foo does not exist is not an indirect object.
	247	# print foo "bar" where foo does not exist is an indirect object.
84251760	248	eval 'sub AUTOLOAD { "ok ", shift, "\n"; }';
6dc4e5ce	249	ok(1);
af09ea45	250
a397c3d9	251	# Bug ID 20010902.002
6dc4e5ce	252	is(
a397c3d9	253	eval q[
9bfdb36e	254	my $x = 'x'; # Lexical or package variable, 5.6.1 panics.
a397c3d9 RGS	255	sub Foo::x : lvalue { $x }
	256	Foo->$x = 'ok';
	257	] \|\| $@, 'ok'
	258	);
	259
3ad83ce7 AMS	260	# An autoloaded, inherited DESTROY may be invoked differently than normal
	261	# methods, and has been known to give rise to spurious warnings
	262	# eg <200203121600.QAA11064@gizmo.fdgroup.co.uk>
	263
	264	{
	265	use warnings;
	266	my $w = '';
	267	local $SIG{__WARN__} = sub { $w = $_[0] };
	268
	269	sub AutoDest::Base::AUTOLOAD {}
	270	@AutoDest::ISA = qw(AutoDest::Base);
	271	{ my $x = bless {}, 'AutoDest'; }
	272	$w =~ s/\n//g;
6dc4e5ce	273	is($w, '');
3ad83ce7 AMS	274	}
3ad83ce7 AMS	275
e189a56d IK	276	# [ID 20020305.025] PACKAGE::SUPER doesn't work anymore
	277
	278	package main;
	279	our @X;
	280	package Amajor;
	281	sub test {
	282	push @main::X, 'Amajor', @_;
	283	}
	284	package Bminor;
	285	use base qw(Amajor);
	286	package main;
	287	sub Bminor::test {
	288	$_[0]->Bminor::SUPER::test('x', 'y');
	289	push @main::X, 'Bminor', @_;
	290	}
	291	Bminor->test('y', 'z');
	292	is("@X", "Amajor Bminor x y Bminor Bminor y z");
	293
0dae17bd GS	294	package main;
	295	for my $meth (['Bar', 'Foo::Bar'],
	296	['SUPER::Bar', 'main::SUPER::Bar'],
	297	['Xyz::SUPER::Bar', 'Xyz::SUPER::Bar'])
	298	{
	299	fresh_perl_is(<<EOT,
	300	package UNIVERSAL; sub AUTOLOAD { my \$c = shift; print "\$c \$AUTOLOAD\\n" }
	301	package Xyz;
	302	package main; Foo->$meth->[0]();
	303	EOT
	304	"Foo $meth->[1]",
	305	{ switches => [ '-w' ] },
	306	"check if UNIVERSAL::AUTOLOAD works",
	307	);
	308	}
1f15e670 NT	309
	310	# Test for #71952: crash when looking for a nonexistent destructor
	311	# Regression introduced by fbb3ee5af3d4
	312	{
	313	fresh_perl_is(<<'EOT',
	314	sub M::DESTROY; bless {}, "M" ; print "survived\n";
	315	EOT
	316	"survived",
	317	{},
	318	"no crash with a declared but missing DESTROY method"
	319	);
	320	}
	321