Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 535 lines (438 sloc) 16.003 kB
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
1 use v6;
2
3 use Test;
4
9c00c3e [t] merge oo/class_inclusion_with_inherited_class.t into spec/
moritz authored
5 plan 128;
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';
297e783 [t] and [t/spec]
moritz authored
57 ok($foo.bar() ~~ undef, '.. autogenerated accessor works');
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
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
0e9f8f9 [t/spec] remove tests that used 'is build' or 'will build' from A12
moritz authored
130 #?rakudo skip 'calling positional params by name'
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
0e9f8f9 [t/spec] remove tests that used 'is build' or 'will build' from A12
moritz authored
137 submethod BUILD($self, $.bar, $.baz, $!hidden) {}
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
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
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
151 #?rakudo skip 'invalid arg type in named args (submethod)'
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
173 {
174 class Foo6b {
175 has $.bar is rw;
176 has $.baz;
177
178 submethod BUILD ($.bar = 10, $.baz?) {
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
179 $!baz = 9;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
180 return;
181 }
182 }
183
184 my $foo = Foo6b.new(bar => 7);
185 ok($foo ~~ Foo6b, '... our Foo6b instance was created');
186
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
187 #?rakudo todo 'named argument passing to BUILD'
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
188 is($foo.bar, 7, "getting a public rw attribute (1)" );
189 is($foo.baz, 9, "getting a public rw attribute (2)" );
190 }
191
d154816 [t/spec] more smartlink fixing
moritz authored
192 # L<S12/Attributes>
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
193 ok eval('class Foo7e { has $.attr = 42 }; 1'), "class definition worked";
194 is eval('Foo7e.new.attr'), 42, "default attribute value (1)";
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
195
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
196 {
197 my $was_in_supplier = 0;
198 sub forty_two_supplier() { $was_in_supplier++; 42 }
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
199 ok eval('class Foo10e { has $.attr = forty_two_supplier() }; 1'),
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
200 'class definition using "= {...}" worked';
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
201 is eval('Foo10e.new.attr'), 42, "default attribute value (4)";
6b40e88 [t/spec] Some unfudging, test review/tweak and additional tests for a…
jnthn authored
202 is $was_in_supplier, 1, "forty_two_supplier() was actually executed";
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
203 eval('Foo10e.new');
6b40e88 [t/spec] Some unfudging, test review/tweak and additional tests for a…
jnthn authored
204 is $was_in_supplier, 2, "forty_two_supplier() is executed per instantiation";
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
205 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
206
207 # check that doing something in submethod BUILD works
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
208 {
209 class Foo7 {
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
210 has $.bar;
211 has $.baz;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
212
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
213 submethod BUILD ($.bar = 5, $baz = 10 ) {
214 $!baz = 2 * $baz;
215 }
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
216 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
217
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
218 my $foo7 = Foo7.new();
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
219 #?rakudo skip "attributes as named parameters in BUILD"
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
220 is( $foo7.bar, 5,
221 'optional attribute should take default value without passed-in value' );
222 is( $foo7.baz, 20,
223 '... optional non-attribute should too' );
224 $foo7 = Foo7.new( :bar(4), :baz(5) );
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
225 #?rakudo 2 skip "attributes as named parameters in BUILD"
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
226 is( $foo7.bar, 4,
227 'optional attribute should take passed-in value over default' );
228 is( $foo7.baz, 10,
229 '... optional non-attribute should too' );
230 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
231
232
233 # check that args are passed to BUILD
234 {
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
235 class Foo8 {
236 has $.a;
237 has $.b;
238
239 submethod BUILD(:$foo, :$bar) {
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
240 $!a = $foo;
241 $!b = $bar;
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
242 }
243 }
244
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
245 my $foo = Foo8.new(foo => 'c', bar => 'd');
246 ok($foo.isa(Foo8), '... our Foo8 instance was created');
247
248 is($foo.a, 'c', 'BUILD received $foo');
249 is($foo.b, 'd', 'BUILD received $bar');
250 }
251
252 # check mixture of positional/named args to BUILD
253
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
254 {
255 class Foo9 {
256 has $.a;
257 has $.b;
258
259 submethod BUILD($foo, :$bar) {
260 $.a = $foo;
261 $.b = $bar;
262 }
263 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
264
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
265 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
266 }
267
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
268 # check $self is passed to BUILD
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
269 {
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
270 class Foo10 {
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
271 has $.a;
272 has $.b;
273 has $.c;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
274
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
275 submethod BUILD($self: :$foo, :$bar) {
276 $!a = $foo;
277 $!b = $bar;
278 $!c = 'y' if $self.isa(Foo10);
279 }
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
280 }
281
282 {
283 my $foo = Foo10.new(foo => 'c', bar => 'd');
284 ok($foo.isa(Foo10), '... our Foo10 instance was created');
285
286 is($foo.a, 'c', 'BUILD received $foo');
287 is($foo.b, 'd', 'BUILD received $bar');
288 is($foo.c, 'y', 'BUILD received $self');
289 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
290 }
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
291
e913c98 [t/spec] regression tests for RT #61100
moritz authored
292 {
293 class WHAT_ref { };
294 class WHAT_test {
295 has WHAT_ref $.a;
296 has WHAT_test $.b is rw;
297 }
298 my $o = WHAT_test.new(a => WHAT_ref.new(), b => WHAT_test.new());
ccbeedd [t/spec]: Use isa_ok instead of WHAT to test types.
pmichaud authored
299 isa_ok $o.a.WHAT, WHAT_ref, '.WHAT on attributes';
300 isa_ok $o.b.WHAT, WHAT_test, '.WHAT on attributes of same type as class';
e913c98 [t/spec] regression tests for RT #61100
moritz authored
301 my $r = WHAT_test.new();
302 lives_ok {$r.b = $r}, 'type check on recursive data structure';
ccbeedd [t/spec]: Use isa_ok instead of WHAT to test types.
pmichaud authored
303 isa_ok $r.b.WHAT, WHAT_test, '.WHAT on recursive data structure';
e913c98 [t/spec] regression tests for RT #61100
moritz authored
304
305 }
306
40a5eeb [t/spec] Add test for RT#64654 issue, now that Rakudo seems to handle…
jnthn authored
307 {
308 class ClosureWithself {
309 has $.cl = { self.foo }
310 method foo { 42 }
311 }
312 is ClosureWithself.new.cl().(), 42, 'use of self in closure on RHS of attr init works';
313 }
314
315
e47e77f [t/spec] Tests for .clone with parameters.
jnthn authored
316 # Tests for clone.
317 {
318 class CloneTest { has $.x is rw; has $.y is rw; }
319 my $a = CloneTest.new(x => 1, y => 2);
320 my $b = $a.clone();
321 is $b.x, 1, 'attribute cloned';
322 is $b.y, 2, 'attribute cloned';
323 $b.x = 3;
324 is $b.x, 3, 'changed attribute on clone...';
325 is $a.x, 1, '...and original not affected';
326 my $c = $a.clone(x => 42);
327 is $c.x, 42, 'clone with parameters...';
328 is $a.x, 1, '...leaves original intact...';
329 is $c.y, 2, '...and copies what we did not change.';
330 }
331
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
332 # tests for *-1 indexing on classes, RT #61766
333 {
334 class ArrayAttribTest {
335 has @.a is rw;
336 method init {
337 @.a = <a b c>;
338 }
339 method m0 { @.a[0] };
340 method m1 { @.a[*-2] };
341 method m2 { @.a[*-1] };
342 }
343 my $o = ArrayAttribTest.new;
344 $o.init;
345 is $o.m0, 'a', '@.a[0] works';
346 is $o.m1, 'b', '@.a[*-2] works';
29b569a [t/spec] unfudge @.a[*-1] tests for rakudo
moritz authored
347 is $o.m2, 'c', '@.a[*-1] works';
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
348 }
349
350 {
351 class AttribWriteTest {
352 has @.a;
353 has %.h;
6e5773d [t/spec] correct some OO tests that I broke before, masak++
moritz authored
354 method set_array1 {
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
355 @.a = <c b a>;
356 }
6e5773d [t/spec] correct some OO tests that I broke before, masak++
moritz authored
357 method set_array2 {
358 @!a = <c b a>;
359 }
360 method set_hash1 {
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
361 %.h = (a => 1, b => 2);
362 }
6e5773d [t/spec] correct some OO tests that I broke before, masak++
moritz authored
363 method set_hash2 {
364 %!h = (a => 1, b => 2);
365 }
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
366 }
367
368 my $x = AttribWriteTest.new;
6e5773d [t/spec] correct some OO tests that I broke before, masak++
moritz authored
369 # see Larry's reply to
370 # http://groups.google.com/group/perl.perl6.language/browse_thread/thread/2bc6dfd8492b87a4/9189d19e30198ebe?pli=1
371 # on why these should fail.
372 dies_ok { $x.set_array1 }, 'can not assign to @.array attribute';
373 dies_ok { $x.set_hash1 }, 'can not assign to %.hash attribute';
374 lives_ok { $x.set_array2 }, 'can assign to @!array attribute';
375 lives_ok { $x.set_hash2 }, 'can assign to %!hash attribute';
2e82ab2 [t/spec] tests for RT #61914
moritz authored
376 }
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
377
2e82ab2 [t/spec] tests for RT #61914
moritz authored
378 # test that whitespaces after 'has (' are allowed.
379 # This used to be a Rakudo bug (RT #61914)
380 {
381 class AttribWsTest {
382 has ( $.this,
383 $.that,
384 );
385 }
386 my AttribWsTest $o .= new( this => 3, that => 4);
387 is $o.this, 3, 'could use whitespace after "has ("';
388 is $o.that, 4, '.. and a newline within the has() declarator';
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
389 }
62eb139 [t/spec] Test for RT#62902.
jnthn authored
390
391 # test typed attributes and === (was Rakudo RT#62902).
392 {
393 class TA1 { }
394 class TA2 {
395 has TA1 $!a;
396 method foo { $!a === TA1 }
397 }
398 ok(TA2.new.foo, '=== works on typed attribute initialized with proto-object');
399 }
400
8cdbdfd [t/spec] merge attribute_of_return_value.t into instance.t
moritz authored
401 # used to be pugs regression
402 {
403 class C_Test { has $.a; }
404 sub f() { C_Test.new(:a(123)) }
405 sub g() { my C_Test $x .= new(:a(123)); $x }
406
407 is(C_Test.new(:a(123)).a, 123, 'C_Test.new().a worked');
408
409 my $o = f();
410 is($o.a, 123, 'my $o = f(); $o.a worked');
411
412 is((try { f().a }), 123, 'f().a worked (so the pugsbug is fixed (part 1))');
413
414 is((try { g().a }), 123, 'g().a worked (so the pugsbug is fixed (part 2))');
415 }
416
1e1543a [t] merge oo/attributes/attribute_list.t into instance.t
moritz authored
417 # was also a pugs regression:
418 # Modification of list attributes created with constructor fails
419
420 {
421 class D_Test {
422 has @.test is rw;
423 method get () { shift @.test }
424 }
425
426 my $test1 = D_Test.new();
427 $test1.test = [1];
428 is($test1.test, [1], "Initialized outside constructor");
429 is($test1.get , 1 , "Get appears to have worked");
430 is($test1.test, [], "Get Worked!");
431
432 my $test2 = D_Test.new( :test([1]) );
433 is($test2.test, [1], "Initialized inside constructor");
434 is($test2.get , 1 , "Get appears to have worked");
435 is($test2.test, [], "Get Worked!");
436 }
437
c077ab0 [t/spec] typed array and hash attributes
moritz authored
438 # test typed attributes
439 # TODO: same checks on private attributes
440 {
441 class TypedAttrib {
442 has Int @.a is rw;
443 has Int %.h is rw;
05c70f6 [t/spec] tests for RT #62838
moritz authored
444 has Int @!pa;
445 has Int %!ph;
446 method pac { @!pa.elems };
447 method phc { %!ph.elems };
c077ab0 [t/spec] typed array and hash attributes
moritz authored
448 }
449 my $o = try { TypedAttrib.new };
450 ok $o.defined, 'created object with typed attributes';
05c70f6 [t/spec] tests for RT #62838
moritz authored
451 is $o.a.elems, 0, 'typed public array attribute is empty';
452 is $o.h.elems, 0, 'typed public hash attribute is empty';
453 is $o.pac, 0, 'typed private array attribute is empty';
454 is $o.phc, 0, 'typed private hash attribute is empty';
71ef855 [t/spec] Some unfuding for Rakudo.
jnthn authored
455
c077ab0 [t/spec] typed array and hash attributes
moritz authored
456 ok $o.a.of === Int, 'array attribute is typed';
457 lives_ok { $o.a = (2, 3) }, 'Can assign to typed drw-array-attrib';
458 lives_ok { $o.a[2] = 4 }, 'Can insert into typed rw-array-attrib';
459 lives_ok { $o.a.push: 5 }, 'Can push onto typed rw-array-attrib';
460 is $o.a.join('|'), '2|3|4|5',
461 '... all of the above actually worked (not only lived)';
462
463 dies_ok { $o.a = <foo bar> }, 'type enforced on array attrib (assignment)';
464 dies_ok { $o.a[2] = $*IN }, 'type enforced on array attrib (item assignment)';
465 dies_ok { $o.a.push: [2, 3]}, 'type enforced on array attrib (push)';
466 dies_ok { $o.a[42]<foo> = 3}, 'no autovivification (typed array)';
467
71ef855 [t/spec] Some unfuding for Rakudo.
jnthn authored
468 #?rakudo todo 'over-eager auto-vivification bugs'
c077ab0 [t/spec] typed array and hash attributes
moritz authored
469 is $o.a.join('|'), '2|3|4|5',
470 '... all of the above actually did nothing (not just died)';
471
472 ok $o.h.of === Int, 'hash attribute is typed';
473 lives_ok {$o.h = { a => 1, b => 2 } }, 'assign to typed hash attrib';
474 lives_ok {$o.h<c> = 3}, 'insertion into typed hash attrib';
475 lives_ok {$o.h.push: (d => 4) }, 'pushing onto typed hash attrib';
476 is_deeply $o.h<a b c d>, (1, 2, 3, 4), '... all of them worked';
477
478 dies_ok {$o.h = { :a<b> } }, 'Type enforced (hash, assignment)';
479 dies_ok {$o.h<a> = 'b' }, 'Type enforced (hash, insertion)';
480 dies_ok {$o.h.push: (g => 'f') }, 'Type enforced (hash, push)';
481 dies_ok {$o.h<blubb><bla> = 3 }, 'No autovivification (typed hash)';
482 is_deeply $o.h<a b c d>, (1, 2, 3, 4), 'hash still unchanged';
483 }
6b40e88 [t/spec] Some unfudging, test review/tweak and additional tests for a…
jnthn authored
484
485 # attribute initialization based upon other attributes
486 {
487 class AttrInitTest {
488 has $.a = 1;
489 has $.b = 2;
490 has $.c = $.a + $.b;
491 }
492 is AttrInitTest.new.c, 3, 'Can initialize one attribute based on another (1)';
493 is AttrInitTest.new(a => 2).c, 4, 'Can initialize one attribute based on another (2)';
494 is AttrInitTest.new(c => 9).c, 9, 'Can initialize one attribute based on another (3)';
495 }
496
e9a791f [t/spec] Tests for attributes with the & sigil.
jnthn authored
497 # attributes with & sigil
498 {
499 class CodeAttr1 { has &!m = sub { "ok" }; method f { &!m() } }
500 is CodeAttr1.new.f, "ok", '&!m = sub { ... } works and an be called';
501
502 class CodeAttr2 { has &.a = { "woot" }; method foo { &!a() } }
503 is CodeAttr2.new.foo, "woot", '&.a = { ... } works and also declares &!a';
504 is CodeAttr2.new.a().(), "woot", '&.a has accessor returning closure';
505
506 class CodeAttr3 { has &!m = method { "OH HAI" }; method f { self.&!m() } }
507 is CodeAttr3.new.f, 'OH HAI', '&!m = method { ... } and self.&!m() work';
508 }
509
9c00c3e [t] merge oo/class_inclusion_with_inherited_class.t into spec/
moritz authored
510 {
511 # from t/oo/class_inclusion_with_inherited_class.t
512 # used to be a pugs regression
513
514 role A {
515 method t ( *@a ) {
516 [+] @a;
517 }
518 }
519
520 class B does A {}
521
522 class C does A {
523 has $.s is rw;
524 has B $.b is rw;
525 submethod BUILD {
526 $.b = B.new;
527 $.s = $.b.t(1, 2, 3);
528 }
529 }
530
531 is C.new.s, 6, "Test class include another class which inherited from same role";
532 }
533
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
534 # vim: ft=perl6
Something went wrong with that request. Please try again.