Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

187 lines (147 sloc) 5.596 kb
use v6;
use Test;
plan 39;
# L<S12/Single inheritance/An "isa" is just a trait that happens to be another class>
class Foo {
has $.bar is rw;
has $.value is rw;
method baz { return 'Foo::baz' }
method getme($self:) returns Foo { return $self }
}
class Foo::Bar is Foo {
has $.bar2 is rw;
method baz { return 'Foo::Bar::baz' }
method fud { return 'Foo::Bar::fud' }
method super_baz ($self:) { return $self.Foo::baz() }
}
class Unrelated {
method something { 'bad' };
}
my $foo_bar = Foo::Bar.new();
isa_ok($foo_bar, Foo::Bar);
ok(!defined($foo_bar.bar2()), '... we have our autogenerated accessor');
ok(!defined($foo_bar.bar()), '... we inherited the superclass autogenerated accessor');
lives_ok { $foo_bar.bar = 'BAR' }, '... our inherited the superclass autogenerated accessor is rw';
is($foo_bar.bar(), 'BAR', '... our inherited the superclass autogenerated accessor is rw');
lives_ok { $foo_bar.bar2 = 'BAR2'; }, '... our autogenerated accessor is rw';
is($foo_bar.bar2(), 'BAR2', '... our autogenerated accessor is rw');
is($foo_bar.baz(), 'Foo::Bar::baz', '... our subclass overrides the superclass method');
is($foo_bar.super_baz(), 'Foo::baz', '... our subclass can still access the superclass method through Foo::');
is($foo_bar.fud(), 'Foo::Bar::fud', '... sanity check on uninherited method');
is($foo_bar.getme, $foo_bar, 'can call inherited methods');
is($foo_bar.getme.baz, "Foo::Bar::baz", 'chained method dispatch on altered method');
ok(!defined($foo_bar.value), 'value can be used for attribute name in derived classes');
my $fud;
lives_ok { $fud = $foo_bar.getme.fud }, 'chained method dispatch on altered method';
is($fud, "Foo::Bar::fud", "returned value is correct");
is $foo_bar.Foo::baz, 'Foo::baz', '$obj.Class::method syntax works';
#?pugs todo
dies_ok { $foo_bar.Unrelated::something() },
'Cannot call unrelated method with $obj.Class::method syntax';
# See thread "Quick OO .isa question" on p6l started by Ingo Blechschmidt:
# L<"http://www.nntp.perl.org/group/perl.perl6.language/22220">
ok Foo::Bar.isa(Foo), "subclass.isa(superclass) is true";
ok Foo::Bar.isa(Foo::Bar), "subclass.isa(same_subclass) is true";
#?pugs skip 'No compatible multi variant found: "&isa"'
ok Foo::Bar.HOW.isa(Foo::Bar, Foo), "subclass.HOW.isa(superclass) is true";
#?pugs skip 'No compatible multi variant found: "&isa"'
ok Foo::Bar.HOW.isa(Foo::Bar, Foo::Bar), "subclass.HOW.isa(same_subclass) is true";
#?pugs todo
{
my $test = '$obj.$meth is canonical (audreyt says)';
class Abc {
method foo () { "found" }
}
class Child is Abc { }
is( eval('my $meth = "foo"; my $obj= Child.new; $obj."$meth"()'), 'found', $test);
}
# Erroneous dispatch found by TimToady++
class X {
method j () { 'X' }
};
class Z is X {}
class Y is X {
method k () { Z.new.j() }
method j () { 'Y' }
};
is(Z.new.j(), 'X', 'inherited method dispatch works');
is(Y.new.k(), 'X', 'inherited method dispatch works inside another class with same-named method');
{
my class A {
has @.x = <a b c>;
has $.w = 9;
method y($i) { return @.x[$i]; }
}
my class B is A {
has $.w = 10;
method z($i) { return $.y($i); }
}
is( B.new.z(1), 'b', 'initializer carries through' );
is( B.new.w, 10, 'initializer can be overridden by derived classes' );
}
# test that you can inherit from a class with :: in the name.
{
class A::B {
method ab { 'a'; };
};
class A::B::C is A::B {
method abc { 'b'; };
}
my $o = A::B::C.new;
ok defined($o), 'can instantiate object from class A::B::C';
is $o.ab, 'a', 'can access inherited method';
is $o.abc, 'b', 'can access directly defined method';
}
# Make sure inheritance from Mu works (got broken in Rakudo once).
eval_lives_ok 'class NotAny is Mu { }; NotAny.new', 'inheritance from Mu works';
{
class DirectMu is Mu { };
ok DirectMu !~~ Any, 'class inheriting from Mu is not Any';
#?niecza skip 'Unable to resolve method parents in class ClassHOW'
#?pugs skip 'No such method in class Class: "&parents"'
ok !( any(DirectMu.^parents).gist eq 'Any()'), 'and Any does not appear in the list of parents either';
}
#?pugs todo
eval_dies_ok 'class RT64642 is ::Nowhere {}', 'dies: class D is ::C {}';
# check that inheriting from Array works
#?pugs skip "Can't modify constant item: VUndef"
{
class ArrayChild is Array {
method summary() { self.join(', ') }
}
my $a = ArrayChild.new;
$a.push('foo');
$a.push('bar');
is $a.join('|'), 'foo|bar', 'inheritance from Array';
is $a.summary, 'foo, bar', 'and ArrayChild methods work';
my @a := ArrayChild.new;
@a.push: 3, 5;
is @a.summary, '3, 5', 'new methods still work in @ variables';
}
# RT #82814
#?pugs skip 'callsame'
{
my class A {
method new { self.bless(*) }
};
my class B is A {
has $.c is rw;
method new {
my $obj = callsame;
$obj.c = 42;
return $obj
}
}
is B.new.c, 42, 'nextsame in constructor works';
}
# RT 75376
#?pugs skip 'No such subroutine: "&RT75376::B"'
#?niecza skip "Pathed definitions require our scope"
{
my class RT75376::A { };
lives_ok { our class RT75376::B is RT75376::A { } },
'our-scoped class can inherit from my-scoped class';
ok (RT75376::B.^mro[0] ~~ RT75376::B and RT75376::B.^mro[1] ~~ RT75376::A),
'our-scoped class inherited from my-scoped class has proper inheritance hierarchy';
}
# vim: ft=perl6
Jump to Line
Something went wrong with that request. Please try again.