Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 178 lines (138 sloc) 5.265 kb
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
1 use v6;
2
3 use Test;
4
fd2b5a2 @bbkr our-scoped class can inherit from my-scoped class, RT #75376
bbkr authored
5 plan 39;
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
6
8aaac76 @diakopter fix a bunch of smartlinks in S12, broken by me and TimToady++
diakopter authored
7 # L<S12/Single inheritance/An "isa" is just a trait that happens to be another class>
c2f8fec [t] and [t/spec] (two train travels worth of changes):
moritz authored
8
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
9 class Foo {
10 has $.bar is rw;
11 has $.value is rw;
12 method baz { return 'Foo::baz' }
13 method getme($self:) returns Foo { return $self }
14 }
15
16 class Foo::Bar is Foo {
17 has $.bar2 is rw;
18 method baz { return 'Foo::Bar::baz' }
19 method fud { return 'Foo::Bar::fud' }
20 method super_baz ($self:) { return $self.Foo::baz() }
21 }
22
fbb9cce [t/spec] test for RT #69262
moritz authored
23 class Unrelated {
24 method something { 'bad' };
25 }
26
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
27 my $foo_bar = Foo::Bar.new();
1382f33 [spec] S12-class/inheritance.t: fudged for rakudo
moritz authored
28 isa_ok($foo_bar, Foo::Bar);
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
29
91adc3f [t/spec] more test fixes wrt undef
moritz authored
30 ok(!defined($foo_bar.bar2()), '... we have our autogenerated accessor');
ecb5a4c [t/spec] fixed a test
moritz authored
31 ok(!defined($foo_bar.bar()), '... we inherited the superclass autogenerated accessor');
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
32
1382f33 [spec] S12-class/inheritance.t: fudged for rakudo
moritz authored
33 lives_ok { $foo_bar.bar = 'BAR' }, '... our inherited the superclass autogenerated accessor is rw';
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
34 is($foo_bar.bar(), 'BAR', '... our inherited the superclass autogenerated accessor is rw');
35
1382f33 [spec] S12-class/inheritance.t: fudged for rakudo
moritz authored
36 lives_ok { $foo_bar.bar2 = 'BAR2'; }, '... our autogenerated accessor is rw';
62fbc52 [spectest] Unskip and un-todo some more tests that Rakudo is now passing...
jnthn authored
37
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
38 is($foo_bar.bar2(), 'BAR2', '... our autogenerated accessor is rw');
39
40 is($foo_bar.baz(), 'Foo::Bar::baz', '... our subclass overrides the superclass method');
1382f33 [spec] S12-class/inheritance.t: fudged for rakudo
moritz authored
41
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
42 is($foo_bar.super_baz(), 'Foo::baz', '... our subclass can still access the superclass method through Foo::');
43 is($foo_bar.fud(), 'Foo::Bar::fud', '... sanity check on uninherited method');
44
45 is($foo_bar.getme, $foo_bar, 'can call inherited methods');
46 is($foo_bar.getme.baz, "Foo::Bar::baz", 'chained method dispatch on altered method');
47
91adc3f [t/spec] more test fixes wrt undef
moritz authored
48 ok(!defined($foo_bar.value), 'value can be used for attribute name in derived classes');
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
49 my $fud;
50
1382f33 [spec] S12-class/inheritance.t: fudged for rakudo
moritz authored
51 lives_ok { $fud = $foo_bar.getme.fud }, 'chained method dispatch on altered method';
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
52 is($fud, "Foo::Bar::fud", "returned value is correct");
53
fbb9cce [t/spec] test for RT #69262
moritz authored
54 is $foo_bar.Foo::baz, 'Foo::baz', '$obj.Class::method syntax works';
55 dies_ok { $foo_bar.Unrelated::something() },
56 'Cannot call unrelated method with $obj.Class::method syntax';
57
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
58 # See thread "Quick OO .isa question" on p6l started by Ingo Blechschmidt:
59 # L<"http://www.nntp.perl.org/group/perl.perl6.language/22220">
60
61 ok Foo::Bar.isa(Foo), "subclass.isa(superclass) is true";
62 ok Foo::Bar.isa(Foo::Bar), "subclass.isa(same_subclass) is true";
dfb71b1 [t/spec] Some reviewing and re-fudging of S12-class/inheritance.t. Toss ...
jnthn authored
63 ok Foo::Bar.HOW.isa(Foo::Bar, Foo), "subclass.HOW.isa(superclass) is true";
64 ok Foo::Bar.HOW.isa(Foo::Bar, Foo::Bar), "subclass.HOW.isa(same_subclass) is true";
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
65
66 {
1382f33 [spec] S12-class/inheritance.t: fudged for rakudo
moritz authored
67 my $test = '$obj.$meth is canonical (audreyt says)';
68 class Abc {
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
69 method foo () { "found" }
70 }
1382f33 [spec] S12-class/inheritance.t: fudged for rakudo
moritz authored
71 class Child is Abc { }
06ae909 @FROGGS eval => EVAL in S10 to S12
FROGGS authored
72 is( EVAL('my $meth = "foo"; my $obj= Child.new; $obj."$meth"()'), 'found', $test);
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
73 }
74
75 # Erroneous dispatch found by TimToady++
76
77 class X {
78 method j () { 'X' }
79 };
80 class Z is X {}
81 class Y is X {
82 method k () { Z.new.j() }
83 method j () { 'Y' }
84 };
85
86 is(Z.new.j(), 'X', 'inherited method dispatch works');
87 is(Y.new.k(), 'X', 'inherited method dispatch works inside another class with same-named method');
88
89 {
13da829 @moritz RT #82814 unspeakable evil with constructors and nextsame
moritz authored
90 my class A {
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
91 has @.x = <a b c>;
92 has $.w = 9;
93
94 method y($i) { return @.x[$i]; }
95 }
96
13da829 @moritz RT #82814 unspeakable evil with constructors and nextsame
moritz authored
97 my class B is A {
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
98 has $.w = 10;
99 method z($i) { return $.y($i); }
100 }
101
102 is( B.new.z(1), 'b', 'initializer carries through' );
5180aec @Util Fix typos.
Util authored
103 is( B.new.w, 10, 'initializer can be overridden by derived classes' );
45208dc [spec] moved oo/inheritance.t to spec/, and updated it a bit
moritz authored
104 }
a4c0991 [t/spec] add (skipped) tests for [perl #60356] (can't inherit from a cla...
moritz authored
105
106 # test that you can inherit from a class with :: in the name.
107 {
108 class A::B {
109 method ab { 'a'; };
110 };
111
112 class A::B::C is A::B {
113 method abc { 'b'; };
114 }
115 my $o = A::B::C.new;
116
117 ok defined($o), 'can instantiate object from class A::B::C';
118 is $o.ab, 'a', 'can access inherited method';
119 is $o.abc, 'b', 'can access directly defined method';
120 }
8f57885 [t/spec] Test for RT#66998.
jnthn authored
121
5180aec @Util Fix typos.
Util authored
122 # Make sure inheritance from Mu works (got broken in Rakudo once).
8f9a119 [t/] unify compartmentalized undef and Object concepts into Mu
lwall authored
123 eval_lives_ok 'class NotAny is Mu { }; NotAny.new', 'inheritance from Mu works';
72b5030 [t/spec] test that class A is Mu { } does not have anything to do with A...
moritz authored
124 {
125 class DirectMu is Mu { };
126 ok DirectMu !~~ Any, 'class inheriting from Mu is not Any';
9a74f7f @coke niecza fudge
coke authored
127 #?niecza skip 'Unable to resolve method parents in class ClassHOW'
4debe16 @moritz more Type() -> (Type) gistification
moritz authored
128 ok !( any(DirectMu.^parents).gist eq '(Any)'), 'and Any does not appear in the list of parents either';
72b5030 [t/spec] test that class A is Mu { } does not have anything to do with A...
moritz authored
129 }
fc47c84 [t/spec] Test for RT #64642
kyle authored
130
131 eval_dies_ok 'class RT64642 is ::Nowhere {}', 'dies: class D is ::C {}';
7f29bc5 [t/spec] Add vim: lines everywhere.
kyle authored
132
bfe67a6 @moritz [inheritance.t] tests for RT #74844
moritz authored
133 # check that inheriting from Array works
134 {
135 class ArrayChild is Array {
136 method summary() { self.join(', ') }
137 }
138
139 my $a = ArrayChild.new;
140 $a.push('foo');
141 $a.push('bar');
142 is $a.join('|'), 'foo|bar', 'inheritance from Array';
143 is $a.summary, 'foo, bar', 'and ArrayChild methods work';
144
145 my @a := ArrayChild.new;
146 @a.push: 3, 5;
147 is @a.summary, '3, 5', 'new methods still work in @ variables';
148
149 }
150
13da829 @moritz RT #82814 unspeakable evil with constructors and nextsame
moritz authored
151 # RT #82814
152 {
153 my class A {
d2a9e62 @moritz remove * from bless
moritz authored
154 method new { self.bless }
13da829 @moritz RT #82814 unspeakable evil with constructors and nextsame
moritz authored
155 };
156 my class B is A {
157 has $.c is rw;
158 method new {
159 my $obj = callsame;
160 $obj.c = 42;
161 return $obj
162 }
163 }
164 is B.new.c, 42, 'nextsame in constructor works';
165 }
166
fd2b5a2 @bbkr our-scoped class can inherit from my-scoped class, RT #75376
bbkr authored
167 # RT 75376
dc9f15f @colomon Lots of niecza fudges.
colomon authored
168 #?niecza skip "Pathed definitions require our scope"
fd2b5a2 @bbkr our-scoped class can inherit from my-scoped class, RT #75376
bbkr authored
169 {
170 my class RT75376::A { };
171 lives_ok { our class RT75376::B is RT75376::A { } },
172 'our-scoped class can inherit from my-scoped class';
173 ok (RT75376::B.^mro[0] ~~ RT75376::B and RT75376::B.^mro[1] ~~ RT75376::A),
174 'our-scoped class inherited from my-scoped class has proper inheritance hierarchy';
175 }
176
7f29bc5 [t/spec] Add vim: lines everywhere.
kyle authored
177 # vim: ft=perl6
Something went wrong with that request. Please try again.