Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 351 lines (281 sloc) 10.328 kb
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
1 use v6;
2
3 use Test;
4
e47e77f [t/spec] Tests for .clone with parameters.
jnthn authored
5 plan 83;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
6
7 =begin pod
8
9 Class attributes tests from L<S12/Attributes>
10
11 =end pod
12
13 eval_dies_ok 'has $.x;', "'has' only works inside of class|role definitions";
14
15 # L<S12/Attributes/the automatic generation of an accessor method of the same name>
16
17 class Foo1 { has $.bar; };
18
19 {
20 my $foo = Foo1.new();
21 ok($foo ~~ Foo1, '... our Foo1 instance was created');
22 my $val;
23 #?pugs 2 todo 'feature'
24 lives_ok {
25 $val = $foo.can("bar")
26 }, '.. checking autogenerated accessor existence';
27 ok($val, '... $foo.can("bar") should have returned true');
28 ok($foo.bar() ~~ undef, '.. autogenerated accessor works');
29 ok($foo.bar ~~ undef, '.. autogenerated accessor works w/out parens');
30 }
31
32 # L<S12/Attributes/Pseudo-assignment to an attribute declaration specifies the default>
33
34 {
35 class Foo2 { has $.bar = "baz"; };
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
36 my $foo = Foo2.new();
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
37 ok($foo ~~ Foo2, '... our Foo2 instance was created');
38 ok($foo.can("bar"), '.. checking autogenerated accessor existence');
39 is($foo.bar(), "baz", '.. autogenerated accessor works');
40 is($foo.bar, "baz", '.. autogenerated accessor works w/out parens');
41 dies_ok { $foo.bar = 'blubb' }, 'attributes are ro by default';
42 }
43
44 # L<S12/Attributes/making it an lvalue method>
45
46
47 #?pugs todo 'instance attributes'
48 {
49 class Foo3 { has $.bar is rw; };
50 my $foo = Foo3.new();
51 ok($foo ~~ Foo3, '... our Foo3 instance was created');
52 my $val;
53 lives_ok {
54 $val = $foo.can("bar");
55 }, '.. checking autogenerated accessor existence';
56 ok $val, '... $foo.can("bar") should have returned true';
57 is($foo.bar(), undef, '.. autogenerated accessor works');
58 lives_ok {
59 $foo.bar = "baz";
60 }, '.. autogenerated mutator as lvalue works';
61 is($foo.bar, "baz", '.. autogenerated mutator as lvalue set the value correctly');
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
62 #?rakudo 2 todo 'oo'
63 lives_ok { $foo.bar("baz2"); }, '.. autogenerated mutator works as method';
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
64 is $foo.bar, "baz2", '.. autogenerated mutator as method set the value correctly';
65 }
66
67 # L<S12/Attributes/Private attributes use an exclamation to indicate that no public accessor is>
68
69
70 {
71 class Foo4 { has $!bar; };
72 my $foo = Foo4.new();
73 ok($foo ~~ Foo4, '... our Foo4 instance was created');
74 #?pugs eval 'todo'
75 ok(!$foo.can("bar"), '.. checking autogenerated accessor existence', );
76 }
77
78
79 {
80 class Foo4a { has $!bar = "baz"; };
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
81 my $foo = Foo4a.new();
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
82 ok($foo ~~ Foo4a, '... our Foo4a instance was created');
83 #?pugs eval 'todo'
84 ok(!$foo.can("bar"), '.. checking autogenerated accessor existence');
85 }
86
87
88 # L<S12/Attributes>
89
90
91 {
92 class Foo5 {
93 has $.tail is rw;
94 has @.legs;
95 has $!brain;
96
97 method set_legs (*@legs) { @.legs = @legs }
98 method inc_brain () { $!brain++ }
99 method get_brain () { $!brain }
100 };
101 my $foo = Foo5.new();
102 ok($foo ~~ Foo5, '... our Foo5 instance was created');
103
104 lives_ok {
105 $foo.tail = "a";
106 }, "setting a public rw attribute";
107 is($foo.tail, "a", "getting a public rw attribute");
108
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
109 #?rakudo 2 todo 'oo'
110 lives_ok { $foo.set_legs(1,2,3) }, "setting a public ro attribute (1)";
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
111 is($foo.legs.[1], 2, "getting a public ro attribute (1)");
112
113 dies_ok {
114 $foo.legs = (4,5,6);
115 }, "setting a public ro attribute (2)";
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
116 #?rakudo todo 'oo'
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
117 is($foo.legs.[1], 2, "getting a public ro attribute (2)");
118
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
119 lives_ok { $foo.inc_brain(); }, "modifiying a private attribute (1)";
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
120 is($foo.get_brain, 1, "getting a private attribute (1)");
121 lives_ok {
122 $foo.inc_brain();
123 }, "modifiying a private attribute (2)";
124 is($foo.get_brain, 2, "getting a private attribute (2)");
125 }
126
127 # L<S12/Construction and Initialization/If you name an attribute as a parameter, that attribute is initialized directly, so>
128
129
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
130 #?rakudo skip 'parse fail'
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
131 {
132 class Foo6 {
133 has $.bar is rw;
134 has $.baz;
135 has $!hidden;
136
137 submethod BUILD($.bar, $.baz, $!hidden) {}
138 method get_hidden() { $!hidden }
139 }
140
141 my $foo = Foo6.new(bar => 1, baz => 2, hidden => 3);
142 ok($foo ~~ Foo6, '... our Foo6 instance was created');
143
144 is($foo.bar, 1, "getting a public rw attribute (1)" );
145 is($foo.baz, 2, "getting a public ro attribute (2)" );
146 is($foo.get_hidden, 3, "getting a private ro attribute (3)" );
147 }
148
149 # check that doing something in submethod BUILD works
150
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
151 #?rakudo skip 'parse fail'
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
152 {
153 class Foo6a {
154 has $.bar is rw;
155 has $.baz;
156 has $!hidden;
157
158 submethod BUILD ($!hidden, $.bar = 10, $.baz?) {
159 $.baz = 5;
160 }
161 method get_hidden() { $!hidden }
162 }
163
164 my $foo = Foo6a.new(bar => 1, hidden => 3);
165 ok($foo ~~ Foo6a, '... our Foo6a instance was created');
166
167 is($foo.bar, 1, "getting a public rw attribute (1)" );
168 is($foo.baz, 5, "getting a public rw attribute (2)" );
169 is($foo.get_hidden, 3, "getting a private ro attribute (3)" );
170 }
171
172 # check that assignment in submethod BUILD works with a bare return, too
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
173 #?rakudo skip 'parse fail'
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
174 {
175 class Foo6b {
176 has $.bar is rw;
177 has $.baz;
178
179 submethod BUILD ($.bar = 10, $.baz?) {
180 $.baz = 9;
181 return;
182 }
183 }
184
185 my $foo = Foo6b.new(bar => 7);
186 ok($foo ~~ Foo6b, '... our Foo6b instance was created');
187
188 is($foo.bar, 7, "getting a public rw attribute (1)" );
189 is($foo.baz, 9, "getting a public rw attribute (2)" );
190 }
191
192 # L<A12/Default Values>
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
193 ok eval('class Foo7 { has $.attr = 42 }; 1'), "class definition worked";
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
194 is eval('Foo7.new.attr'), 42, "default attribute value (1)";
195
196 # L<A12/Default Values/is equivalent to this:>
b9575c7 [t/spec] Unfudge some attribute initialization tests that Rakudo now …
jnthn authored
197 #?rakudo 4 skip 'attribute initialization'
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
198 ok eval('class Foo8 { has $.attr is build(42) }; 1'),
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
199 "class definition using 'is build' worked";
200 is eval('Foo8.new.attr'), 42, "default attribute value (2)";
201
202 # L<A12/Default Values/is equivalent to this:>
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
203 ok eval('class Foo9 { has $.attr will build(42) }; 1'),
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
204 "class definition using 'will build' worked";
205 is eval('Foo9.new.attr'), 42, "default attribute value (3)";
206
b9575c7 [t/spec] Unfudge some attribute initialization tests that Rakudo now …
jnthn authored
207 #?rakudo skip 'lexicals visible outside eval'
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
208 {
209 my $was_in_supplier = 0;
210 sub forty_two_supplier() { $was_in_supplier++; 42 }
211 ok eval('class Foo10 { has $.attr = { forty_two_supplier() } }; 1'),
212 'class definition using "= {...}" worked';
213 is eval('Foo10.new.attr'), 42, "default attribute value (4)";
214 is $was_in_supplier, 1, "forty_two_supplier() was actually executed (1)";
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
215
216 # The same, but using 'is build {...}'
217 # XXX: Currently hard parsefail!
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
218 ok eval('class Foo11 { has $.attr is build { forty_two_supplier() } }; 1'),
219 'class definition using "is build {...}" worked';
220 is eval('Foo11.new.attr'), 42, "default attribute value (5)";
221 is $was_in_supplier, 2, "forty_two_supplier() was actually executed (2)";
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
222
223 # The same, but using 'will build {...}'
224 # XXX: Currently hard parsefail!
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
225 ok eval('class Foo12 { has $.attr will build { forty_two_supplier() } }; 1'),
226 "class definition using 'will build {...}' worked";
227 is eval('Foo11.new.attr'), 42, "default attribute value (6)";
228 is $was_in_supplier, 3, "forty_two_supplier() was actually executed (3)";
229 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
230
231 # check that doing something in submethod BUILD works
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
232 #?rakudo skip 'parse failure'
233 {
234 class Foo7 {
235 has $.bar;
236 has $.baz;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
237
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
238 submethod BUILD ($.bar = 5, $baz = 10 ) {
239 $.baz = 2 * $baz;
240 }
241 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
242
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
243 my $foo7 = Foo7.new();
244 is( $foo7.bar, 5,
245 'optional attribute should take default value without passed-in value' );
246 is( $foo7.baz, 20,
247 '... optional non-attribute should too' );
248 $foo7 = Foo7.new( :bar(4), :baz(5) );
249 is( $foo7.bar, 4,
250 'optional attribute should take passed-in value over default' );
251 is( $foo7.baz, 10,
252 '... optional non-attribute should too' );
253 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
254
255
256 # check that args are passed to BUILD
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
257 #?rakudo skip 'submethod parsing'
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
258 {
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
259 class Foo8 {
260 has $.a;
261 has $.b;
262
263 submethod BUILD(:$foo, :$bar) {
264 $.a = $foo;
265 $.b = $bar;
266 }
267 }
268
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
269 my $foo = Foo8.new(foo => 'c', bar => 'd');
270 ok($foo.isa(Foo8), '... our Foo8 instance was created');
271
272 is($foo.a, 'c', 'BUILD received $foo');
273 is($foo.b, 'd', 'BUILD received $bar');
274 }
275
276 # check mixture of positional/named args to BUILD
277
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
278 #?rakudo skip 'submethod parsing'
279 {
280 class Foo9 {
281 has $.a;
282 has $.b;
283
284 submethod BUILD($foo, :$bar) {
285 $.a = $foo;
286 $.b = $bar;
287 }
288 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
289
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
290 dies_ok({ Foo9.new('pos', bar => 'd') }, 'cannot pass positional to .new');
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
291 }
292
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
293 # check $self is passed to BUILD
294 #?rakudo skip 'submethod parsing'
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
295 {
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
296 class Foo10 {
297 has $.a;
298 has $.b;
299 has $.c;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
300
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
301 submethod BUILD(Class $self: :$foo, :$bar) {
302 $.a = $foo;
303 $.b = $bar;
304 $.c = 'y' if $self.isa(Foo10);
305 }
306 }
307
308 {
309 my $foo = Foo10.new(foo => 'c', bar => 'd');
310 ok($foo.isa(Foo10), '... our Foo10 instance was created');
311
312 is($foo.a, 'c', 'BUILD received $foo');
313 is($foo.b, 'd', 'BUILD received $bar');
314 is($foo.c, 'y', 'BUILD received $self');
315 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
316 }
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
317
e913c98 [t/spec] regression tests for RT #61100
moritz authored
318 {
319 class WHAT_ref { };
320 class WHAT_test {
321 has WHAT_ref $.a;
322 has WHAT_test $.b is rw;
323 }
324 my $o = WHAT_test.new(a => WHAT_ref.new(), b => WHAT_test.new());
325 is $o.a.WHAT, 'WHAT_ref', '.WHAT on attributes';
326 is $o.b.WHAT, 'WHAT_test', '.WHAT on attributes of same type as class';
327 my $r = WHAT_test.new();
328 #?rakudo 2 todo 'RT #61100'
329 lives_ok {$r.b = $r}, 'type check on recursive data structure';
330 is $r.b.WHAT, 'WHAT_test', '.WHAT on recursive data structure';
331
332 }
333
e47e77f [t/spec] Tests for .clone with parameters.
jnthn authored
334 # Tests for clone.
335 {
336 class CloneTest { has $.x is rw; has $.y is rw; }
337 my $a = CloneTest.new(x => 1, y => 2);
338 my $b = $a.clone();
339 is $b.x, 1, 'attribute cloned';
340 is $b.y, 2, 'attribute cloned';
341 $b.x = 3;
342 is $b.x, 3, 'changed attribute on clone...';
343 is $a.x, 1, '...and original not affected';
344 my $c = $a.clone(x => 42);
345 is $c.x, 42, 'clone with parameters...';
346 is $a.x, 1, '...leaves original intact...';
347 is $c.y, 2, '...and copies what we did not change.';
348 }
349
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
350 # vim: ft=perl6
Something went wrong with that request. Please try again.