Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 318 lines (251 sloc) 9.126 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
5 plan 72;
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"; };
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
36 my $foo = Foo2.new();
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
37 ok($foo ~~ Foo2, '... our Foo2 instance was created');
38 ok($foo.can("bar"), '.. checking autogenerated accessor existence');
39 is($foo.bar(), "baz", '.. autogenerated accessor works');
40 is($foo.bar, "baz", '.. autogenerated accessor works w/out parens');
41 dies_ok { $foo.bar = 'blubb' }, 'attributes are ro by default';
42 }
43
44 # L<S12/Attributes/making it an lvalue method>
45
46
47 #?pugs todo 'instance attributes'
48 {
49 class Foo3 { has $.bar is rw; };
50 my $foo = Foo3.new();
51 ok($foo ~~ Foo3, '... our Foo3 instance was created');
52 my $val;
53 lives_ok {
54 $val = $foo.can("bar");
55 }, '.. checking autogenerated accessor existence';
56 ok $val, '... $foo.can("bar") should have returned true';
57 is($foo.bar(), undef, '.. autogenerated accessor works');
58 lives_ok {
59 $foo.bar = "baz";
60 }, '.. autogenerated mutator as lvalue works';
61 is($foo.bar, "baz", '.. autogenerated mutator as lvalue set the value correctly');
62 lives_ok {
63 $foo.bar("baz2");
64 }, '.. autogenerated mutator works as method';
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
80 {
81 class Foo4a { has $!bar = "baz"; };
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
82 my $foo = Foo4a.new();
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
83 ok($foo ~~ Foo4a, '... our Foo4a instance was created');
84 #?pugs eval 'todo'
85 ok(!$foo.can("bar"), '.. checking autogenerated accessor existence');
86 }
87
88
89 # L<S12/Attributes>
90
91
92 {
93 class Foo5 {
94 has $.tail is rw;
95 has @.legs;
96 has $!brain;
97
98 method set_legs (*@legs) { @.legs = @legs }
99 method inc_brain () { $!brain++ }
100 method get_brain () { $!brain }
101 };
102 my $foo = Foo5.new();
103 ok($foo ~~ Foo5, '... our Foo5 instance was created');
104
105 lives_ok {
106 $foo.tail = "a";
107 }, "setting a public rw attribute";
108 is($foo.tail, "a", "getting a public rw attribute");
109
110 lives_ok {
111 $foo.set_legs(1,2,3)
112 }, "setting a public ro attribute (1)";
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)";
118 is($foo.legs.[1], 2, "getting a public ro attribute (2)");
119
120 lives_ok {
121 $foo.inc_brain();
122 }, "modifiying a private attribute (1)";
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
130 # L<S12/Construction and Initialization/If you name an attribute as a parameter, that attribute is initialized directly, so>
131
132
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
133 #?rakudo skip 'parse fail'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
134 {
135 class Foo6 {
136 has $.bar is rw;
137 has $.baz;
138 has $!hidden;
139
140 submethod BUILD($.bar, $.baz, $!hidden) {}
141 method get_hidden() { $!hidden }
142 }
143
144 my $foo = Foo6.new(bar => 1, baz => 2, hidden => 3);
145 ok($foo ~~ Foo6, '... our Foo6 instance was created');
146
147 is($foo.bar, 1, "getting a public rw attribute (1)" );
148 is($foo.baz, 2, "getting a public ro attribute (2)" );
149 is($foo.get_hidden, 3, "getting a private ro attribute (3)" );
150 }
151
152 # check that doing something in submethod BUILD works
153
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
154 #?rakudo skip 'parse fail'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
155 {
156 class Foo6a {
157 has $.bar is rw;
158 has $.baz;
159 has $!hidden;
160
161 submethod BUILD ($!hidden, $.bar = 10, $.baz?) {
162 $.baz = 5;
163 }
164 method get_hidden() { $!hidden }
165 }
166
167 my $foo = Foo6a.new(bar => 1, hidden => 3);
168 ok($foo ~~ Foo6a, '... our Foo6a instance was created');
169
170 is($foo.bar, 1, "getting a public rw attribute (1)" );
171 is($foo.baz, 5, "getting a public rw attribute (2)" );
172 is($foo.get_hidden, 3, "getting a private ro attribute (3)" );
173 }
174
175 # check that assignment in submethod BUILD works with a bare return, too
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
176 #?rakudo skip 'parse fail'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
177 {
178 class Foo6b {
179 has $.bar is rw;
180 has $.baz;
181
182 submethod BUILD ($.bar = 10, $.baz?) {
183 $.baz = 9;
184 return;
185 }
186 }
187
188 my $foo = Foo6b.new(bar => 7);
189 ok($foo ~~ Foo6b, '... our Foo6b instance was created');
190
191 is($foo.bar, 7, "getting a public rw attribute (1)" );
192 is($foo.baz, 9, "getting a public rw attribute (2)" );
193 }
194
195 # L<A12/Default Values>
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
209 my $was_in_supplier = 0;
210 sub forty_two_supplier() { $was_in_supplier++; 42 }
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
211 ok eval('class Foo10 { has $.attr = { forty_two_supplier() } }; 1'),
212 'class definition using "= {...}" worked';
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
213 is eval('Foo10.new.attr'), 42, "default attribute value (4)";
214 is $was_in_supplier, 1, "forty_two_supplier() was actually executed (1)";
215
216 # The same, but using 'is build {...}'
217 # XXX: Currently hard parsefail!
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
218 ok eval('class Foo11 { has $.attr is build { forty_two_supplier() } }; 1'),
219 'class definition using "is build {...}" worked';
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
220 is eval('Foo11.new.attr'), 42, "default attribute value (5)";
221 is $was_in_supplier, 2, "forty_two_supplier() was actually executed (2)";
222
223 # The same, but using 'will build {...}'
224 # XXX: Currently hard parsefail!
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
225 ok eval('class Foo12 { has $.attr will build { forty_two_supplier() } }; 1'),
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
226 "class definition using 'will build {...}' worked";
227 is eval('Foo11.new.attr'), 42, "default attribute value (6)";
228 is $was_in_supplier, 3, "forty_two_supplier() was actually executed (3)";
229
230 # check that doing something in submethod BUILD works
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
231 #?rakudo skip 'parse failure'
232 {
233 class Foo7 {
234 has $.bar;
235 has $.baz;
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
236
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
237 submethod BUILD ($.bar = 5, $baz = 10 ) {
238 $.baz = 2 * $baz;
239 }
240 }
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
241
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
242 my $foo7 = Foo7.new();
243 is( $foo7.bar, 5,
244 'optional attribute should take default value without passed-in value' );
245 is( $foo7.baz, 20,
246 '... optional non-attribute should too' );
247 $foo7 = Foo7.new( :bar(4), :baz(5) );
248 is( $foo7.bar, 4,
249 'optional attribute should take passed-in value over default' );
250 is( $foo7.baz, 10,
251 '... optional non-attribute should too' );
252 }
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
253
254
255 # check that args are passed to BUILD
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
256 #?rakudo skip 'submethod parsing'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
257 {
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
258 class Foo8 {
259 has $.a;
260 has $.b;
261
262 submethod BUILD(:$foo, :$bar) {
263 $.a = $foo;
264 $.b = $bar;
265 }
266 }
267
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
268 my $foo = Foo8.new(foo => 'c', bar => 'd');
269 ok($foo.isa(Foo8), '... our Foo8 instance was created');
270
271 is($foo.a, 'c', 'BUILD received $foo');
272 is($foo.b, 'd', 'BUILD received $bar');
273 }
274
275 # check mixture of positional/named args to BUILD
276
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
277 #?rakudo skip 'submethod parsing'
278 {
279 class Foo9 {
280 has $.a;
281 has $.b;
282
283 submethod BUILD($foo, :$bar) {
284 $.a = $foo;
285 $.b = $bar;
286 }
287 }
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
288
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
289 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
290 }
291
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
292 # check $self is passed to BUILD
293 #?rakudo skip 'submethod parsing'
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
294 {
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
295 class Foo10 {
296 has $.a;
297 has $.b;
298 has $.c;
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
299
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
300 submethod BUILD(Class $self: :$foo, :$bar) {
301 $.a = $foo;
302 $.b = $bar;
303 $.c = 'y' if $self.isa(Foo10);
304 }
305 }
306
307 {
308 my $foo = Foo10.new(foo => 'c', bar => 'd');
309 ok($foo.isa(Foo10), '... our Foo10 instance was created');
310
311 is($foo.a, 'c', 'BUILD received $foo');
312 is($foo.b, 'd', 'BUILD received $bar');
313 is($foo.c, 'y', 'BUILD received $self');
314 }
eb858daf »
2008-12-07 [t] clean up oo/attributes/instance.t and move it to spec
315 }
b8116e01 »
2008-12-07 [t/spec] more cleanup of instance.t
316
317 # vim: ft=perl6
Something went wrong with that request. Please try again.