Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 639 lines (528 sloc) 18.507 kB
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
1 use v6;
2
3 use Test;
4
0dc03f4 @moritz BUILD should not prevent initialization of attributes it did not mention
moritz authored
5 plan 135;
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');
08f1960 @moritz start to remove .notdef
moritz authored
28 nok($foo.bar().defined, '.. autogenerated accessor works');
29 nok($foo.bar.defined, '.. autogenerated accessor works w/out parens');
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
30 }
31
8aaac76 @diakopter fix a bunch of smartlinks in S12, broken by me and TimToady++
diakopter authored
32 # L<S12/Attribute default values/Pseudo-assignment to an attribute declaration specifies the default>
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
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');
4bc3e06 @colomon Fudge for niecza.
colomon authored
41 #?niecza todo
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
42 dies_ok { $foo.bar = 'blubb' }, 'attributes are ro by default';
43 }
44
45 # L<S12/Attributes/making it an lvalue method>
46
47
48 #?pugs todo 'instance attributes'
49 {
50 class Foo3 { has $.bar is rw; };
51 my $foo = Foo3.new();
52 ok($foo ~~ Foo3, '... our Foo3 instance was created');
53 my $val;
54 lives_ok {
55 $val = $foo.can("bar");
56 }, '.. checking autogenerated accessor existence';
57 ok $val, '... $foo.can("bar") should have returned true';
08f1960 @moritz start to remove .notdef
moritz authored
58 nok($foo.bar().defined, '.. autogenerated accessor works');
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
59 lives_ok {
60 $foo.bar = "baz";
61 }, '.. autogenerated mutator as lvalue works';
62 is($foo.bar, "baz", '.. autogenerated mutator as lvalue set the value correctly');
63 }
64
65 # L<S12/Attributes/Private attributes use an exclamation to indicate that no public accessor is>
66
67
68 {
69 class Foo4 { has $!bar; };
70 my $foo = Foo4.new();
71 ok($foo ~~ Foo4, '... our Foo4 instance was created');
72 #?pugs eval 'todo'
73 ok(!$foo.can("bar"), '.. checking autogenerated accessor existence', );
74 }
75
76
77 {
78 class Foo4a { has $!bar = "baz"; };
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
79 my $foo = Foo4a.new();
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
80 ok($foo ~~ Foo4a, '... our Foo4a instance was created');
81 #?pugs eval 'todo'
82 ok(!$foo.can("bar"), '.. checking autogenerated accessor existence');
83 }
84
85
86 # L<S12/Attributes>
87
88
89 {
90 class Foo5 {
91 has $.tail is rw;
92 has @.legs;
93 has $!brain;
94
95 method set_legs (*@legs) { @.legs = @legs }
96 method inc_brain () { $!brain++ }
97 method get_brain () { $!brain }
98 };
99 my $foo = Foo5.new();
100 ok($foo ~~ Foo5, '... our Foo5 instance was created');
101
102 lives_ok {
103 $foo.tail = "a";
104 }, "setting a public rw attribute";
105 is($foo.tail, "a", "getting a public rw attribute");
106
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
107 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
108 is($foo.legs.[1], 2, "getting a public ro attribute (1)");
109
97c23e5 @moritz refudge and correct S12-attributes/instance.t; add tests for attribut…
moritz authored
110 #?rakudo 2 todo 'ro on list attributes'
4bc3e06 @colomon Fudge for niecza.
colomon authored
111 #?niecza 2 todo 'ro on list attributes'
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
112 dies_ok {
113 $foo.legs = (4,5,6);
114 }, "setting a public ro attribute (2)";
115 is($foo.legs.[1], 2, "getting a public ro attribute (2)");
116
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
117 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
118 is($foo.get_brain, 1, "getting a private attribute (1)");
119 lives_ok {
120 $foo.inc_brain();
121 }, "modifiying a private attribute (2)";
122 is($foo.get_brain, 2, "getting a private attribute (2)");
123 }
124
8aaac76 @diakopter fix a bunch of smartlinks in S12, broken by me and TimToady++
diakopter authored
125 # L<S12/Semantics of C<bless>/If you name an attribute as a parameter, that attribute is initialized directly, so>
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
126
4bc3e06 @colomon Fudge for niecza.
colomon authored
127 #?niecza skip "Unhandled parameter twigil !"
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
128 {
129 class Foo6 {
130 has $.bar is rw;
b02b1ec [t/spec] Unskip/untodo and correct some tests for attributive paramet…
jnthn authored
131 has $.baz is rw;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
132 has $!hidden;
133
97c23e5 @moritz refudge and correct S12-attributes/instance.t; add tests for attribut…
moritz authored
134 submethod BUILD(:$!bar, :$!baz, :$!hidden) {}
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
135 method get_hidden() { $!hidden }
136 }
137
138 my $foo = Foo6.new(bar => 1, baz => 2, hidden => 3);
139 ok($foo ~~ Foo6, '... our Foo6 instance was created');
140
141 is($foo.bar, 1, "getting a public rw attribute (1)" );
142 is($foo.baz, 2, "getting a public ro attribute (2)" );
143 is($foo.get_hidden, 3, "getting a private ro attribute (3)" );
144 }
145
146 # check that doing something in submethod BUILD works
147
4bc3e06 @colomon Fudge for niecza.
colomon authored
148 #?niecza skip "Unhandled parameter twigil !"
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
149 {
150 class Foo6a {
151 has $.bar is rw;
b02b1ec [t/spec] Unskip/untodo and correct some tests for attributive paramet…
jnthn authored
152 has $.baz is rw;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
153 has $!hidden;
154
97c23e5 @moritz refudge and correct S12-attributes/instance.t; add tests for attribut…
moritz authored
155 submethod BUILD (:$!hidden, :$!bar = 10, :$!baz?) {
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
156 $.baz = 5;
157 }
158 method get_hidden() { $!hidden }
159 }
160
161 my $foo = Foo6a.new(bar => 1, hidden => 3);
162 ok($foo ~~ Foo6a, '... our Foo6a instance was created');
163
164 is($foo.bar, 1, "getting a public rw attribute (1)" );
165 is($foo.baz, 5, "getting a public rw attribute (2)" );
166 is($foo.get_hidden, 3, "getting a private ro attribute (3)" );
167 }
168
169 # check that assignment in submethod BUILD works with a bare return, too
4bc3e06 @colomon Fudge for niecza.
colomon authored
170 #?niecza skip "Unhandled parameter twigil !"
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
171 {
172 class Foo6b {
173 has $.bar is rw;
b02b1ec [t/spec] Unskip/untodo and correct some tests for attributive paramet…
jnthn authored
174 has $.baz is rw;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
175
97c23e5 @moritz refudge and correct S12-attributes/instance.t; add tests for attribut…
moritz authored
176 submethod BUILD (:$!bar = 10, :$!baz?) {
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
177 $!baz = 9;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
178 return;
179 }
180 }
181
182 my $foo = Foo6b.new(bar => 7);
183 ok($foo ~~ Foo6b, '... our Foo6b instance was created');
184
185 is($foo.bar, 7, "getting a public rw attribute (1)" );
186 is($foo.baz, 9, "getting a public rw attribute (2)" );
187 }
188
d154816 [t/spec] more smartlink fixing
moritz authored
189 # L<S12/Attributes>
254123a [t/spec] Little more fudge tweaks.
jnthn authored
190 class Foo7e { has $.attr = 42 }
191 is Foo7e.new.attr, 42, "default attribute value (1)";
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
192
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
193 {
194 my $was_in_supplier = 0;
195 sub forty_two_supplier() { $was_in_supplier++; 42 }
bba87f6 [t/spec] Re-fudgings and other tweaks to S12-attributes/instance.t; t…
jnthn authored
196 class Foo10e { has $.attr = forty_two_supplier() }
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
197 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
198 is $was_in_supplier, 1, "forty_two_supplier() was actually executed";
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
199 eval('Foo10e.new');
6b40e88 [t/spec] Some unfudging, test review/tweak and additional tests for a…
jnthn authored
200 is $was_in_supplier, 2, "forty_two_supplier() is executed per instantiation";
b3aadc7 [t/spec] fudge instance.t for rakudo
moritz authored
201 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
202
203 # check that doing something in submethod BUILD works
4bc3e06 @colomon Fudge for niecza.
colomon authored
204 #?niecza skip "Unhandled parameter twigil !"
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
205 {
206 class Foo7 {
b02b1ec [t/spec] Unskip/untodo and correct some tests for attributive paramet…
jnthn authored
207 has $.bar is rw;
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
208 has $.baz;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
209
97c23e5 @moritz refudge and correct S12-attributes/instance.t; add tests for attribut…
moritz authored
210 submethod BUILD (:$!bar = 5, :$!baz = 10 ) {
211 $!baz = 2 * $!baz;
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
212 }
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
213 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
214
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
215 my $foo7 = Foo7.new();
216 is( $foo7.bar, 5,
217 'optional attribute should take default value without passed-in value' );
218 is( $foo7.baz, 20,
219 '... optional non-attribute should too' );
220 $foo7 = Foo7.new( :bar(4), :baz(5) );
221 is( $foo7.bar, 4,
222 'optional attribute should take passed-in value over default' );
223 is( $foo7.baz, 10,
224 '... optional non-attribute should too' );
225 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
226
227
228 # check that args are passed to BUILD
229 {
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
230 class Foo8 {
231 has $.a;
232 has $.b;
233
234 submethod BUILD(:$foo, :$bar) {
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
235 $!a = $foo;
236 $!b = $bar;
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
237 }
238 }
239
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
240 my $foo = Foo8.new(foo => 'c', bar => 'd');
241 ok($foo.isa(Foo8), '... our Foo8 instance was created');
242
243 is($foo.a, 'c', 'BUILD received $foo');
244 is($foo.b, 'd', 'BUILD received $bar');
245 }
246
247 # check mixture of positional/named args to BUILD
248
4bc3e06 @colomon Fudge for niecza.
colomon authored
249 #?niecza skip 'Virtual call $.a may not be used on partially constructed object'
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
250 {
251 class Foo9 {
252 has $.a;
253 has $.b;
254
255 submethod BUILD($foo, :$bar) {
256 $.a = $foo;
257 $.b = $bar;
258 }
259 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
260
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
261 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
262 }
263
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
264 # check $self is passed to BUILD
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
265 {
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
266 class Foo10 {
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
267 has $.a;
268 has $.b;
269 has $.c;
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
270
4095b96 [t/spec]: Some unfudging and re-fudging for rakudo.
pmichaud authored
271 submethod BUILD($self: :$foo, :$bar) {
272 $!a = $foo;
273 $!b = $bar;
274 $!c = 'y' if $self.isa(Foo10);
275 }
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
276 }
277
278 {
279 my $foo = Foo10.new(foo => 'c', bar => 'd');
280 ok($foo.isa(Foo10), '... our Foo10 instance was created');
281
282 is($foo.a, 'c', 'BUILD received $foo');
283 is($foo.b, 'd', 'BUILD received $bar');
284 is($foo.c, 'y', 'BUILD received $self');
285 }
eb858da [t] clean up oo/attributes/instance.t and move it to spec
moritz authored
286 }
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
287
e913c98 [t/spec] regression tests for RT #61100
moritz authored
288 {
289 class WHAT_ref { };
290 class WHAT_test {
291 has WHAT_ref $.a;
292 has WHAT_test $.b is rw;
293 }
294 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
295 isa_ok $o.a.WHAT, WHAT_ref, '.WHAT on attributes';
296 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
297 my $r = WHAT_test.new();
298 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
299 isa_ok $r.b.WHAT, WHAT_test, '.WHAT on recursive data structure';
e913c98 [t/spec] regression tests for RT #61100
moritz authored
300
301 }
302
97c23e5 @moritz refudge and correct S12-attributes/instance.t; add tests for attribut…
moritz authored
303 #?rakudo skip 'self closure'
4bc3e06 @colomon Fudge for niecza.
colomon authored
304 #?niecza skip 'self closure'
40a5eeb [t/spec] Add test for RT#64654 issue, now that Rakudo seems to handle…
jnthn authored
305 {
306 class ClosureWithself {
307 has $.cl = { self.foo }
308 method foo { 42 }
309 }
310 is ClosureWithself.new.cl().(), 42, 'use of self in closure on RHS of attr init works';
311 }
312
313
e47e77f [t/spec] Tests for .clone with parameters.
jnthn authored
314 # Tests for clone.
4bc3e06 @colomon Fudge for niecza.
colomon authored
315 #?niecza skip "Unable to resolve method clone in class CloneTest"
e47e77f [t/spec] Tests for .clone with parameters.
jnthn authored
316 {
317 class CloneTest { has $.x is rw; has $.y is rw; }
318 my $a = CloneTest.new(x => 1, y => 2);
319 my $b = $a.clone();
320 is $b.x, 1, 'attribute cloned';
321 is $b.y, 2, 'attribute cloned';
322 $b.x = 3;
323 is $b.x, 3, 'changed attribute on clone...';
97c23e5 @moritz refudge and correct S12-attributes/instance.t; add tests for attribut…
moritz authored
324 #?rakudo 2 todo 'clone'
e47e77f [t/spec] Tests for .clone with parameters.
jnthn authored
325 is $a.x, 1, '...and original not affected';
326 my $c = $a.clone(x => 42);
327 is $c.x, 42, 'clone with parameters...';
97c23e5 @moritz refudge and correct S12-attributes/instance.t; add tests for attribut…
moritz authored
328 #?rakudo todo 'clone'
e47e77f [t/spec] Tests for .clone with parameters.
jnthn authored
329 is $a.x, 1, '...leaves original intact...';
330 is $c.y, 2, '...and copies what we did not change.';
331 }
332
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
333 # tests for *-1 indexing on classes, RT #61766
334 {
335 class ArrayAttribTest {
336 has @.a is rw;
337 method init {
338 @.a = <a b c>;
339 }
340 method m0 { @.a[0] };
341 method m1 { @.a[*-2] };
342 method m2 { @.a[*-1] };
343 }
344 my $o = ArrayAttribTest.new;
345 $o.init;
346 is $o.m0, 'a', '@.a[0] works';
347 is $o.m1, 'b', '@.a[*-2] works';
29b569a [t/spec] unfudge @.a[*-1] tests for rakudo
moritz authored
348 is $o.m2, 'c', '@.a[*-1] works';
f1fac49 [t/spec] test for RT #75266, indexing array attributes with non-Ints
moritz authored
349
350 # RT #75266
351 is ArrayAttribTest.new(a => <x y z>).a[2.0], 'z',
352 'Can index array attributes with non-integers';
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
353 }
354
355 {
356 class AttribWriteTest {
357 has @.a;
358 has %.h;
6e5773d [t/spec] correct some OO tests that I broke before, masak++
moritz authored
359 method set_array1 {
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
360 @.a = <c b a>;
361 }
6e5773d [t/spec] correct some OO tests that I broke before, masak++
moritz authored
362 method set_array2 {
363 @!a = <c b a>;
364 }
365 method set_hash1 {
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
366 %.h = (a => 1, b => 2);
367 }
6e5773d [t/spec] correct some OO tests that I broke before, masak++
moritz authored
368 method set_hash2 {
369 %!h = (a => 1, b => 2);
370 }
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
371 }
372
373 my $x = AttribWriteTest.new;
6e5773d [t/spec] correct some OO tests that I broke before, masak++
moritz authored
374 # see Larry's reply to
375 # http://groups.google.com/group/perl.perl6.language/browse_thread/thread/2bc6dfd8492b87a4/9189d19e30198ebe?pli=1
376 # on why these should fail.
97c23e5 @moritz refudge and correct S12-attributes/instance.t; add tests for attribut…
moritz authored
377 #?rakudo 2 todo 'ro array/hash with accessor'
4bc3e06 @colomon Fudge for niecza.
colomon authored
378 #?niecza 2 todo 'ro array/hash with accessor'
6e5773d [t/spec] correct some OO tests that I broke before, masak++
moritz authored
379 dies_ok { $x.set_array1 }, 'can not assign to @.array attribute';
380 dies_ok { $x.set_hash1 }, 'can not assign to %.hash attribute';
381 lives_ok { $x.set_array2 }, 'can assign to @!array attribute';
382 lives_ok { $x.set_hash2 }, 'can assign to %!hash attribute';
2e82ab2 [t/spec] tests for RT #61914
moritz authored
383 }
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
384
2e82ab2 [t/spec] tests for RT #61914
moritz authored
385 # test that whitespaces after 'has (' are allowed.
386 # This used to be a Rakudo bug (RT #61914)
4bc3e06 @colomon Fudge for niecza.
colomon authored
387 #?niecza skip 'Unhandled parameter twigil .'
2e82ab2 [t/spec] tests for RT #61914
moritz authored
388 {
389 class AttribWsTest {
390 has ( $.this,
391 $.that,
392 );
393 }
394 my AttribWsTest $o .= new( this => 3, that => 4);
395 is $o.this, 3, 'could use whitespace after "has ("';
396 is $o.that, 4, '.. and a newline within the has() declarator';
17aba30 [t/spec] tests for writing to array and hash attributes
moritz authored
397 }
62eb139 [t/spec] Test for RT#62902.
jnthn authored
398
399 # test typed attributes and === (was Rakudo RT#62902).
400 {
401 class TA1 { }
402 class TA2 {
403 has TA1 $!a;
404 method foo { $!a === TA1 }
405 }
406 ok(TA2.new.foo, '=== works on typed attribute initialized with proto-object');
407 }
408
8cdbdfd [t/spec] merge attribute_of_return_value.t into instance.t
moritz authored
409 # used to be pugs regression
410 {
411 class C_Test { has $.a; }
412 sub f() { C_Test.new(:a(123)) }
413 sub g() { my C_Test $x .= new(:a(123)); $x }
414
415 is(C_Test.new(:a(123)).a, 123, 'C_Test.new().a worked');
416
417 my $o = f();
418 is($o.a, 123, 'my $o = f(); $o.a worked');
419
420 is((try { f().a }), 123, 'f().a worked (so the pugsbug is fixed (part 1))');
421
422 is((try { g().a }), 123, 'g().a worked (so the pugsbug is fixed (part 2))');
423 }
424
1e1543a [t] merge oo/attributes/attribute_list.t into instance.t
moritz authored
425 # was also a pugs regression:
426 # Modification of list attributes created with constructor fails
427
428 {
429 class D_Test {
430 has @.test is rw;
431 method get () { shift @.test }
432 }
433
434 my $test1 = D_Test.new();
435 $test1.test = [1];
436 is($test1.test, [1], "Initialized outside constructor");
437 is($test1.get , 1 , "Get appears to have worked");
438 is($test1.test, [], "Get Worked!");
439
440 my $test2 = D_Test.new( :test([1]) );
441 is($test2.test, [1], "Initialized inside constructor");
442 is($test2.get , 1 , "Get appears to have worked");
443 is($test2.test, [], "Get Worked!");
444 }
445
c077ab0 [t/spec] typed array and hash attributes
moritz authored
446 # test typed attributes
447 # TODO: same checks on private attributes
97c23e5 @moritz refudge and correct S12-attributes/instance.t; add tests for attribut…
moritz authored
448 #?rakudo skip 'typed array/hash'
c077ab0 [t/spec] typed array and hash attributes
moritz authored
449 {
450 class TypedAttrib {
451 has Int @.a is rw;
452 has Int %.h is rw;
05c70f6 [t/spec] tests for RT #62838
moritz authored
453 has Int @!pa;
454 has Int %!ph;
455 method pac { @!pa.elems };
456 method phc { %!ph.elems };
c077ab0 [t/spec] typed array and hash attributes
moritz authored
457 }
458 my $o = try { TypedAttrib.new };
459 ok $o.defined, 'created object with typed attributes';
05c70f6 [t/spec] tests for RT #62838
moritz authored
460 is $o.a.elems, 0, 'typed public array attribute is empty';
461 is $o.h.elems, 0, 'typed public hash attribute is empty';
462 is $o.pac, 0, 'typed private array attribute is empty';
463 is $o.phc, 0, 'typed private hash attribute is empty';
71ef855 [t/spec] Some unfuding for Rakudo.
jnthn authored
464
bba87f6 [t/spec] Re-fudgings and other tweaks to S12-attributes/instance.t; t…
jnthn authored
465 #?rakudo todo 'typed arrays'
4bc3e06 @colomon Fudge for niecza.
colomon authored
466 #?niecza skip "Unable to resolve method of in class Array"
c077ab0 [t/spec] typed array and hash attributes
moritz authored
467 ok $o.a.of === Int, 'array attribute is typed';
468 lives_ok { $o.a = (2, 3) }, 'Can assign to typed drw-array-attrib';
469 lives_ok { $o.a[2] = 4 }, 'Can insert into typed rw-array-attrib';
470 lives_ok { $o.a.push: 5 }, 'Can push onto typed rw-array-attrib';
471 is $o.a.join('|'), '2|3|4|5',
472 '... all of the above actually worked (not only lived)';
473
d5fdcaf [t/spec]: Fudge and fix some tests after autoviv changes.
pmichaud authored
474 #?rakudo 4 todo 'typed arrays'
4bc3e06 @colomon Fudge for niecza.
colomon authored
475 #?niecza 4 todo 'typed arrays'
c077ab0 [t/spec] typed array and hash attributes
moritz authored
476 dies_ok { $o.a = <foo bar> }, 'type enforced on array attrib (assignment)';
477 dies_ok { $o.a[2] = $*IN }, 'type enforced on array attrib (item assignment)';
478 dies_ok { $o.a.push: [2, 3]}, 'type enforced on array attrib (push)';
479 dies_ok { $o.a[42]<foo> = 3}, 'no autovivification (typed array)';
480
71ef855 [t/spec] Some unfuding for Rakudo.
jnthn authored
481 #?rakudo todo 'over-eager auto-vivification bugs'
4bc3e06 @colomon Fudge for niecza.
colomon authored
482 #?niecza todo
c077ab0 [t/spec] typed array and hash attributes
moritz authored
483 is $o.a.join('|'), '2|3|4|5',
484 '... all of the above actually did nothing (not just died)';
485
bba87f6 [t/spec] Re-fudgings and other tweaks to S12-attributes/instance.t; t…
jnthn authored
486 #?rakudo todo 'typed hash'
4bc3e06 @colomon Fudge for niecza.
colomon authored
487 #?niecza skip "Unable to resolve method of in class Hash"
c077ab0 [t/spec] typed array and hash attributes
moritz authored
488 ok $o.h.of === Int, 'hash attribute is typed';
489 lives_ok {$o.h = { a => 1, b => 2 } }, 'assign to typed hash attrib';
490 lives_ok {$o.h<c> = 3}, 'insertion into typed hash attrib';
491 lives_ok {$o.h.push: (d => 4) }, 'pushing onto typed hash attrib';
9647099 [t/spec] some unfudges for rakudo
moritz authored
492
c077ab0 [t/spec] typed array and hash attributes
moritz authored
493 is_deeply $o.h<a b c d>, (1, 2, 3, 4), '... all of them worked';
494
d5fdcaf [t/spec]: Fudge and fix some tests after autoviv changes.
pmichaud authored
495 #?rakudo 5 todo 'typed hash'
0e33d81 @coke niecza fudge
coke authored
496 #?niecza 3 todo
c077ab0 [t/spec] typed array and hash attributes
moritz authored
497 dies_ok {$o.h = { :a<b> } }, 'Type enforced (hash, assignment)';
498 dies_ok {$o.h<a> = 'b' }, 'Type enforced (hash, insertion)';
499 dies_ok {$o.h.push: (g => 'f') }, 'Type enforced (hash, push)';
4bc3e06 @colomon Fudge for niecza.
colomon authored
500 #?niecza 2 todo
c077ab0 [t/spec] typed array and hash attributes
moritz authored
501 dies_ok {$o.h<blubb><bla> = 3 }, 'No autovivification (typed hash)';
502 is_deeply $o.h<a b c d>, (1, 2, 3, 4), 'hash still unchanged';
503 }
6b40e88 [t/spec] Some unfudging, test review/tweak and additional tests for a…
jnthn authored
504
505 # attribute initialization based upon other attributes
4bc3e06 @colomon Fudge for niecza.
colomon authored
506 #?niecza skip 'Variable $.a used where no self is available'
6b40e88 [t/spec] Some unfudging, test review/tweak and additional tests for a…
jnthn authored
507 {
508 class AttrInitTest {
509 has $.a = 1;
510 has $.b = 2;
511 has $.c = $.a + $.b;
512 }
513 is AttrInitTest.new.c, 3, 'Can initialize one attribute based on another (1)';
514 is AttrInitTest.new(a => 2).c, 4, 'Can initialize one attribute based on another (2)';
515 is AttrInitTest.new(c => 9).c, 9, 'Can initialize one attribute based on another (3)';
516 }
517
e9a791f [t/spec] Tests for attributes with the & sigil.
jnthn authored
518 # attributes with & sigil
519 {
520 class CodeAttr1 { has &!m = sub { "ok" }; method f { &!m() } }
521 is CodeAttr1.new.f, "ok", '&!m = sub { ... } works and an be called';
522
523 class CodeAttr2 { has &.a = { "woot" }; method foo { &!a() } }
524 is CodeAttr2.new.foo, "woot", '&.a = { ... } works and also declares &!a';
525 is CodeAttr2.new.a().(), "woot", '&.a has accessor returning closure';
526
527 class CodeAttr3 { has &!m = method { "OH HAI" }; method f { self.&!m() } }
528 is CodeAttr3.new.f, 'OH HAI', '&!m = method { ... } and self.&!m() work';
529 }
530
4bc3e06 @colomon Fudge for niecza.
colomon authored
531 #?niecza skip "Action method trait_mod:does not yet implemented"
9c00c3e [t] merge oo/class_inclusion_with_inherited_class.t into spec/
moritz authored
532 {
533 # from t/oo/class_inclusion_with_inherited_class.t
534 # used to be a pugs regression
535
536 role A {
537 method t ( *@a ) {
538 [+] @a;
539 }
540 }
541
542 class B does A {}
543
544 class C does A {
545 has $.s is rw;
546 has B $.b is rw;
547 submethod BUILD {
548 $.b = B.new;
549 $.s = $.b.t(1, 2, 3);
550 }
551 }
552
553 is C.new.s, 6, "Test class include another class which inherited from same role";
554 }
555
58322aa [t/spec] Test for RT #68370
kyle authored
556 # RT #68370
557 {
558 class RT68370 {
559 has $!a;
560 method rt68370 { $!a = 68370 }
561 }
562
563 dies_ok { RT68370.rt68370() },
a89bb47 [t/spec] Unfudge a test Rakudo now passes, and tweak its explanation …
jnthn authored
564 'dies: trying to modify instance attribute when invocant is type object';
58322aa [t/spec] Test for RT #68370
kyle authored
565 }
566
a2787a7 [t/spec] Test for binding to an attribute.
jnthn authored
567 # Binding an attribute (was RT #64850)
4bc3e06 @colomon Fudge for niecza.
colomon authored
568 #?niecza skip 'Cannot use bind operator with this LHS'
a2787a7 [t/spec] Test for binding to an attribute.
jnthn authored
569 {
570 class RT64850 {
571 has $.x;
572 method foo { $!x := 42 }
573 }
574 my $a = RT64850.new;
575 $a.foo;
576 is $a.x, 42, 'binding to an attribute works';
577 }
578
9e0e58a [t/spec] test that lexicals escape thunks
moritz authored
579 {
580 class InitializationThunk {
581 has $.foo = my $x = 5;
582 method bar { $x };
583 }
584
585 is InitializationThunk.new.bar, 5, 'a lexical is not tied to a thunk';
586 }
587
a134bd1 [t/spec] test that you can call a method all(), and access attributes…
moritz authored
588 # http://rt.perl.org/rt3/Ticket/Display.html?id=69202
589 {
590 class TestMethodAll {
591 has $.a;
8dc7d4b [t/spec] mark various tests that intentionally declare things that ar…
lwall authored
592 method x(Str $x) {}; #OK not used
a134bd1 [t/spec] test that you can call a method all(), and access attributes…
moritz authored
593 method all() { $!a }
594 }
595 is TestMethodAll.new(a => 5).all, 5, 'Can call a method all()';
596 }
597
f1fac49 [t/spec] test for RT #75266, indexing array attributes with non-Ints
moritz authored
598
d706990 [t/spec] tests for RT #74186, unfudge two similar tests, and switch t…
moritz authored
599 # RT #74186
600 {
601 sub outer { 42 };
602 class AttribLex {
603 sub inner { 23 };
604 has $.outer = outer();
605 has $.inner = inner();
606 }
607 is AttribLex.new.outer, 42, 'Can use outer lexicals in attribut initialization';
608 is AttribLex.new.inner, 23, 'Can use lexicals in attribut initialization';
97c23e5 @moritz refudge and correct S12-attributes/instance.t; add tests for attribut…
moritz authored
609 }
610
611 # RT #85502
612 {
613 class AttribListAssign {
614 has $.a;
615 has $.b;
616 method doit {
617 ($!a, $!b) = <post office>;
618 }
619 }
620 my $x = AttribListAssign.new;
621 $x.doit;
622 is $x.a, 'post', 'list assignment to attributes (1)';
623 isa_ok $x.a, Str, 'list assignment to attributes (type)';
624 is $x.b, 'office', 'list assignment to attributes (2)';
d706990 [t/spec] tests for RT #74186, unfudge two similar tests, and switch t…
moritz authored
625
626 }
627
0dc03f4 @moritz BUILD should not prevent initialization of attributes it did not mention
moritz authored
628 # RT #68498
629 {
630 class Foo { has $.bar = "baz"; submethod BUILD {} }
631 is Foo.new.bar, 'baz',
632 'presence of BUILD does not prevent assignment of default values';
633
634 }
635
e76dd4c @moritz s/done_testing/done/ as per recent S24 changes
moritz authored
636 done();
d706990 [t/spec] tests for RT #74186, unfudge two similar tests, and switch t…
moritz authored
637
b8116e0 [t/spec] more cleanup of instance.t
moritz authored
638 # vim: ft=perl6
Something went wrong with that request. Please try again.