Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 337 lines (268 sloc) 9.904 kb
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
1 use v6;
2
3 use Test;
4
e913c98c »
2008-12-07 [t/spec] regression tests for RT #61100
5 plan 76;
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
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
b3aadc74 »
2008-12-07 [t/spec] fudge instance.t for rakudo
34 #?rakudo skip 'initialization of attributes'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
35 {
36 class Foo2 { has $.bar = "baz"; };
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
37 my $foo = Foo2.new();
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
38 ok($foo ~~ Foo2, '... our Foo2 instance was created');
39 ok($foo.can("bar"), '.. checking autogenerated accessor existence');
40 is($foo.bar(), "baz", '.. autogenerated accessor works');
41 is($foo.bar, "baz", '.. autogenerated accessor works w/out parens');
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';
58 is($foo.bar(), undef, '.. autogenerated accessor works');
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');
b3aadc74 »
2008-12-07 [t/spec] fudge instance.t for rakudo
63 #?rakudo 2 todo 'oo'
64 lives_ok { $foo.bar("baz2"); }, '.. autogenerated mutator works as method';
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
65 is $foo.bar, "baz2", '.. autogenerated mutator as method set the value correctly';
66 }
67
68 # L<S12/Attributes/Private attributes use an exclamation to indicate that no public accessor is>
69
70
71 {
72 class Foo4 { has $!bar; };
73 my $foo = Foo4.new();
74 ok($foo ~~ Foo4, '... our Foo4 instance was created');
75 #?pugs eval 'todo'
76 ok(!$foo.can("bar"), '.. checking autogenerated accessor existence', );
77 }
78
79
b3aadc74 »
2008-12-07 [t/spec] fudge instance.t for rakudo
80 #?rakudo skip 'initialization of attributes'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
81 {
82 class Foo4a { has $!bar = "baz"; };
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
83 my $foo = Foo4a.new();
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
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");
110
b3aadc74 »
2008-12-07 [t/spec] fudge instance.t for rakudo
111 #?rakudo 2 todo 'oo'
112 lives_ok { $foo.set_legs(1,2,3) }, "setting a public ro attribute (1)";
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
113 is($foo.legs.[1], 2, "getting a public ro attribute (1)");
114
115 dies_ok {
116 $foo.legs = (4,5,6);
117 }, "setting a public ro attribute (2)";
b3aadc74 »
2008-12-07 [t/spec] fudge instance.t for rakudo
118 #?rakudo todo 'oo'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
119 is($foo.legs.[1], 2, "getting a public ro attribute (2)");
120
b3aadc74 »
2008-12-07 [t/spec] fudge instance.t for rakudo
121 lives_ok { $foo.inc_brain(); }, "modifiying a private attribute (1)";
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
122 is($foo.get_brain, 1, "getting a private attribute (1)");
123 lives_ok {
124 $foo.inc_brain();
125 }, "modifiying a private attribute (2)";
126 is($foo.get_brain, 2, "getting a private attribute (2)");
127 }
128
129 # L<S12/Construction and Initialization/If you name an attribute as a parameter, that attribute is initialized directly, so>
130
131
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
132 #?rakudo skip 'parse fail'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
133 {
134 class Foo6 {
135 has $.bar is rw;
136 has $.baz;
137 has $!hidden;
138
139 submethod BUILD($.bar, $.baz, $!hidden) {}
140 method get_hidden() { $!hidden }
141 }
142
143 my $foo = Foo6.new(bar => 1, baz => 2, hidden => 3);
144 ok($foo ~~ Foo6, '... our Foo6 instance was created');
145
146 is($foo.bar, 1, "getting a public rw attribute (1)" );
147 is($foo.baz, 2, "getting a public ro attribute (2)" );
148 is($foo.get_hidden, 3, "getting a private ro attribute (3)" );
149 }
150
151 # check that doing something in submethod BUILD works
152
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
153 #?rakudo skip 'parse fail'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
154 {
155 class Foo6a {
156 has $.bar is rw;
157 has $.baz;
158 has $!hidden;
159
160 submethod BUILD ($!hidden, $.bar = 10, $.baz?) {
161 $.baz = 5;
162 }
163 method get_hidden() { $!hidden }
164 }
165
166 my $foo = Foo6a.new(bar => 1, hidden => 3);
167 ok($foo ~~ Foo6a, '... our Foo6a instance was created');
168
169 is($foo.bar, 1, "getting a public rw attribute (1)" );
170 is($foo.baz, 5, "getting a public rw attribute (2)" );
171 is($foo.get_hidden, 3, "getting a private ro attribute (3)" );
172 }
173
174 # check that assignment in submethod BUILD works with a bare return, too
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
175 #?rakudo skip 'parse fail'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
176 {
177 class Foo6b {
178 has $.bar is rw;
179 has $.baz;
180
181 submethod BUILD ($.bar = 10, $.baz?) {
182 $.baz = 9;
183 return;
184 }
185 }
186
187 my $foo = Foo6b.new(bar => 7);
188 ok($foo ~~ Foo6b, '... our Foo6b instance was created');
189
190 is($foo.bar, 7, "getting a public rw attribute (1)" );
191 is($foo.baz, 9, "getting a public rw attribute (2)" );
192 }
193
194 # L<A12/Default Values>
b3aadc74 »
2008-12-07 [t/spec] fudge instance.t for rakudo
195 #?rakudo 6 skip 'attribute initialization'
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
196 ok eval('class Foo7 { has $.attr = 42 }; 1'), "class definition worked";
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
197 is eval('Foo7.new.attr'), 42, "default attribute value (1)";
198
199 # L<A12/Default Values/is equivalent to this:>
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
200 ok eval('class Foo8 { has $.attr is build(42) }; 1'),
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
201 "class definition using 'is build' worked";
202 is eval('Foo8.new.attr'), 42, "default attribute value (2)";
203
204 # L<A12/Default Values/is equivalent to this:>
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
205 ok eval('class Foo9 { has $.attr will build(42) }; 1'),
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
206 "class definition using 'will build' worked";
207 is eval('Foo9.new.attr'), 42, "default attribute value (3)";
208
b3aadc74 »
2008-12-07 [t/spec] fudge instance.t for rakudo
209 #?rakudo skip 'attribute initialization'
210 {
211 my $was_in_supplier = 0;
212 sub forty_two_supplier() { $was_in_supplier++; 42 }
213 ok eval('class Foo10 { has $.attr = { forty_two_supplier() } }; 1'),
214 'class definition using "= {...}" worked';
215 is eval('Foo10.new.attr'), 42, "default attribute value (4)";
216 is $was_in_supplier, 1, "forty_two_supplier() was actually executed (1)";
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
217
218 # The same, but using 'is build {...}'
219 # XXX: Currently hard parsefail!
b3aadc74 »
2008-12-07 [t/spec] fudge instance.t for rakudo
220 ok eval('class Foo11 { has $.attr is build { forty_two_supplier() } }; 1'),
221 'class definition using "is build {...}" worked';
222 is eval('Foo11.new.attr'), 42, "default attribute value (5)";
223 is $was_in_supplier, 2, "forty_two_supplier() was actually executed (2)";
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
224
225 # The same, but using 'will build {...}'
226 # XXX: Currently hard parsefail!
b3aadc74 »
2008-12-07 [t/spec] fudge instance.t for rakudo
227 ok eval('class Foo12 { has $.attr will build { forty_two_supplier() } }; 1'),
228 "class definition using 'will build {...}' worked";
229 is eval('Foo11.new.attr'), 42, "default attribute value (6)";
230 is $was_in_supplier, 3, "forty_two_supplier() was actually executed (3)";
231 }
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
232
233 # check that doing something in submethod BUILD works
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
234 #?rakudo skip 'parse failure'
235 {
236 class Foo7 {
237 has $.bar;
238 has $.baz;
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
239
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
240 submethod BUILD ($.bar = 5, $baz = 10 ) {
241 $.baz = 2 * $baz;
242 }
243 }
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
244
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
245 my $foo7 = Foo7.new();
246 is( $foo7.bar, 5,
247 'optional attribute should take default value without passed-in value' );
248 is( $foo7.baz, 20,
249 '... optional non-attribute should too' );
250 $foo7 = Foo7.new( :bar(4), :baz(5) );
251 is( $foo7.bar, 4,
252 'optional attribute should take passed-in value over default' );
253 is( $foo7.baz, 10,
254 '... optional non-attribute should too' );
255 }
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
256
257
258 # check that args are passed to BUILD
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
259 #?rakudo skip 'submethod parsing'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
260 {
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
261 class Foo8 {
262 has $.a;
263 has $.b;
264
265 submethod BUILD(:$foo, :$bar) {
266 $.a = $foo;
267 $.b = $bar;
268 }
269 }
270
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
271 my $foo = Foo8.new(foo => 'c', bar => 'd');
272 ok($foo.isa(Foo8), '... our Foo8 instance was created');
273
274 is($foo.a, 'c', 'BUILD received $foo');
275 is($foo.b, 'd', 'BUILD received $bar');
276 }
277
278 # check mixture of positional/named args to BUILD
279
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
280 #?rakudo skip 'submethod parsing'
281 {
282 class Foo9 {
283 has $.a;
284 has $.b;
285
286 submethod BUILD($foo, :$bar) {
287 $.a = $foo;
288 $.b = $bar;
289 }
290 }
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
291
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
292 dies_ok({ Foo9.new('pos', bar => 'd') }, 'cannot pass positional to .new');
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
293 }
294
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
295 # check $self is passed to BUILD
296 #?rakudo skip 'submethod parsing'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
297 {
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
298 class Foo10 {
299 has $.a;
300 has $.b;
301 has $.c;
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
302
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
303 submethod BUILD(Class $self: :$foo, :$bar) {
304 $.a = $foo;
305 $.b = $bar;
306 $.c = 'y' if $self.isa(Foo10);
307 }
308 }
309
310 {
311 my $foo = Foo10.new(foo => 'c', bar => 'd');
312 ok($foo.isa(Foo10), '... our Foo10 instance was created');
313
314 is($foo.a, 'c', 'BUILD received $foo');
315 is($foo.b, 'd', 'BUILD received $bar');
316 is($foo.c, 'y', 'BUILD received $self');
317 }
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
318 }
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
319
e913c98c »
2008-12-07 [t/spec] regression tests for RT #61100
320 {
321 class WHAT_ref { };
322 class WHAT_test {
323 has WHAT_ref $.a;
324 has WHAT_test $.b is rw;
325 }
326 my $o = WHAT_test.new(a => WHAT_ref.new(), b => WHAT_test.new());
327 is $o.a.WHAT, 'WHAT_ref', '.WHAT on attributes';
328 is $o.b.WHAT, 'WHAT_test', '.WHAT on attributes of same type as class';
329 my $r = WHAT_test.new();
330 #?rakudo 2 todo 'RT #61100'
331 lives_ok {$r.b = $r}, 'type check on recursive data structure';
332 is $r.b.WHAT, 'WHAT_test', '.WHAT on recursive data structure';
333
334 }
335
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
336 # vim: ft=perl6
Something went wrong with that request. Please try again.