Skip to content

HTTPS clone URL

Subversion checkout URL

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