59 lines
1.4 KiB
Perl
59 lines
1.4 KiB
Perl
use strict;
|
|
use warnings;
|
|
use Test::More tests => 9;
|
|
BEGIN { use_ok 'director_nested' }
|
|
require_ok 'director_nested';
|
|
|
|
{
|
|
package A;
|
|
use base 'director_nested::FooBar_int';
|
|
sub do_step { 'A::do_step;' }
|
|
sub get_value { 'A::get_value' }
|
|
}
|
|
|
|
my $a = A->new();
|
|
isa_ok $a, 'A';
|
|
|
|
is $a->step(), "Bar::step;Foo::advance;Bar::do_advance;A::do_step;",
|
|
'A virtual resolution';
|
|
|
|
{
|
|
package B;
|
|
use base 'director_nested::FooBar_int';
|
|
sub do_advance { my($self) = @_;
|
|
return "B::do_advance;" . $self->do_step();
|
|
}
|
|
sub do_step { "B::do_step;" }
|
|
sub get_value { 1 }
|
|
}
|
|
|
|
my $b = B->new();
|
|
isa_ok $b, 'B';
|
|
is $b->step(), "Bar::step;Foo::advance;B::do_advance;B::do_step;",
|
|
'B virtual resolution';
|
|
|
|
{
|
|
package C;
|
|
use base 'director_nested::FooBar_int';
|
|
our $in_do_advance = 0;
|
|
sub do_advance { my($self) = @_;
|
|
# found a case where upcall didn't happen right in a perl space
|
|
# SUPER:: call.
|
|
die "SUPERCALL RESOLVE FAILURE" if $in_do_advance;
|
|
local $in_do_advance = 1;
|
|
return "C::do_advance;" .
|
|
$self->SUPER::do_advance();
|
|
}
|
|
sub do_step { "C::do_step;" }
|
|
sub get_value { 2 }
|
|
sub get_name { my($self) = @_;
|
|
return $self->director_nested::FooBar_int::get_name() . " hello";
|
|
}
|
|
}
|
|
|
|
my $cc = C->new();
|
|
isa_ok $cc, 'C';
|
|
my $c = director_nested::FooBar_int::get_self($cc);
|
|
$c->advance();
|
|
is $c->get_name(), "FooBar::get_name hello";
|
|
is $c->name(), "FooBar::get_name hello";
|