Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 110 lines (79 sloc) 3.522 kb
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
1 use v6;
2
3 use Test;
4
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
5 plan 34;
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
6
7 # L<S12/Attribute default values/The value on the right is evaluated at object build time>
8
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
9 my $got_a_num = 0; sub get_a_num { $got_a_num++; 42 }
10 my $got_a_str = 0; sub get_a_str { $got_a_str++; "Pugs" }
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
11
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
12 # Everything on the RHS of the = is implicitly a closure.
13 # Providing a closure means the attribute is a closure!
14 {
15 $got_a_num = 0;
16 $got_a_str = 0;
17
18 class Spaceship {
19 has $.num = get_a_num();
20 has $.str = { get_a_str() };
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
21 };
22
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
23 is $got_a_num, 0, "default should not be called at compile-time";
24 is $got_a_str, 0, "default should not be called at compile-time";
25
26 my Spaceship $spaceship .= new;
27
28 is $got_a_num, 1, "default should be called only once in construction";
29 is $spaceship.num, 42, "attribute default worked";
30 is $got_a_num, 1, "default should be called only once";
31
32 is $got_a_str, 0, "default should not have been called yet";
33 ok $spaceship.str ~~ Callable, "attribute default is a closure";
34 is $got_a_str, 0, "default should not have been called yet";
35 is $spaceship.str()(), "Pugs", "attribute can be called";
36 is $got_a_str, 1, "and now get_a_str has run";
37
38 my Spaceship $spaceship2 .= new;
39
40 is $got_a_num, 2, "construction of second object also only calls default closure once";
41 is $spaceship2.num, 42, "attribute default worked";
42 is $got_a_num, 2, "default should be called only once";
43
44 is $got_a_str, 1, "construction of second object still doesn't call closure";
45 is $spaceship2.str.(), "Pugs", "attribute default worked, even called the other way";
46 is $got_a_str, 2, "get_a_str now called twice";
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
47 }
48
49 {
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
50 $got_a_num = 0;
51 $got_a_str = 0;
52
53 class Starship {
54 has $.num = get_a_num();
55 has $.str = { get_a_str() };
56 };
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
57
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
58 is $got_a_num, 0, "default should not be called at compile-time";
59 is $got_a_str, 0, "default should not be called at compile-time";
60
61 my Starship $starship .= new(num => 10);
62
63 is $got_a_num, 0, "default should not be called if value provide";
64 is $starship.num, 10, "attribute default worked";
65 is $got_a_num, 0, "default should still not be called";
66
67 is $got_a_str, 0, "default should not have been called yet";
68 ok $starship.str ~~ Callable, "attribute default is a closure";
69 is $got_a_str, 0, "default should not have been called yet";
70 is $starship.str()(), "Pugs", "attribute can be called";
71 is $got_a_str, 1, "and now get_a_str has run";
72
73 my Starship $starship2 .= new(str => "Niecza");
74
75 is $got_a_num, 1, "construction of second object only calls default closure once";
76 is $starship2.num, 42, "attribute default worked";
77 is $got_a_num, 1, "default should be called only once";
78
79 is $got_a_str, 1, "construction of second object still doesn't call closure";
80 is $starship2.str, "Niecza", "attribute default was not used";
81 is $got_a_str, 1, "get_a_str now called twice";
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
82 }
83
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
84 #?niecza skip "'self' used where no object is available"
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
85 {
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
86 class Towel {
87 has $.self_in_code = { self.echo };
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
88
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
89 method echo { "echo" }
90 };
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
91
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
92 my Towel $towel .= new;
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
93
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
94 is $towel.self_in_code()(), "echo", "self is the object being initialized";
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
95 }
96
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
97 #?niecza skip "'self' used where no object is available"
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
98 {
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
99 class Cake {
100 has $.a = "echo";
101 has $.self_in_code = self.a;
102 };
103
104 my Cake $cake .= new;
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
105
15bfd0d @colomon Rewrite test to conform to current standard. moritz++, other p6ers, …
colomon authored
106 is $cake.self_in_code, "echo", "self is the object being initialized";
26d151e @colomon Revert "remove outdated test file", to provide a starting framework f…
colomon authored
107 }
108
109 # vim: ft=perl6
Something went wrong with that request. Please try again.