1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
#!/usr/bin/perl -w
BEGIN
{
chdir 't' if -d 't';
}
use lib '../lib';
use strict;
use Test::More tests => 6;
my $module = 'SUPER';
use_ok( $module ) or exit;
package Foo;
sub go_nowhere
{
my $self = shift;
return $self->SUPER();
}
sub foo
{
return __PACKAGE__;
}
package Bar;
@Bar::ISA = 'Foo';
sub foo
{
return [ $_[0]->SUPER(), __PACKAGE__ ];
}
package Baz;
@Baz::ISA = 'Bar';
sub foo
{
my $self = shift;
$self->SUPER();
}
package Quux;
@Quux::ISA = 'Foo';
*Quux::foo = \&Baz::foo;
*Quux::foo = 1;
package Qaax;
@Qaax::ISA = 'Quux';
package main;
my $baz = bless [], 'Quux';
is( $baz->foo(), 'Foo',
'SUPER() should respect current, not compile-time @ISA' );
*Quux::foo = \&Bar::foo;
is_deeply( $baz->foo(), [ 'Foo', 'Bar' ], '... even when reset' );
is_deeply( Quux->foo(), [ 'Foo', 'Bar' ], '... for class calls too' );
is( Foo->go_nowhere(), (), 'SUPER() and should go nowhere with nowhere to go' );
my $q = bless {}, 'Qaax';
is_deeply( $q->foo(), [ 'Foo', 'Bar' ], 'mu' );
|
