-
Notifications
You must be signed in to change notification settings - Fork 135
/
class.t
158 lines (126 loc) · 3.88 KB
/
class.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
use v6;
use Test;
=begin pod
Class Attributes
=end pod
#L<S12/Class attributes/"Class attributes are declared">
#L<S12/Class methods/Such a metaclass method is always delegated>
plan 29;
class Foo {
our $.bar = 23;
our $.yada = 13;
}
my $test = 0;
ok ($test = Foo.bar), 'accessors for class attributes work';
is $test, 23, 'class attributes really work';
class Baz is Foo {};
my $test2 = 0;
lives_ok { $test2 = Baz.bar }, 'inherited class attribute accessors work';
is $test2, 23, 'inherited class attributes really work';
my $test3 = 0;
lives_ok { Baz.yada = 42; $test3 = Baz.yada }, 'inherited rw class attribute accessors work';
is $test3, 42, 'inherited rw class attributes really work';
class Quux is Foo { has $.bar = 17; };
my $test4 = 0;
lives_ok { $test4 = Quux.new() },
'Can instantiate with overridden instance method';
is $test4.bar, 17, 'Instance call gets instance attribute, not class attribute';
my $test5 = 0;
dies_ok {$test5 = Quux.bar}, 'class attribute accessor hidden by accessor in subclass; we do not magically ignore it';
# L<S12/Class methods/"you can associate a method with the current
# metaclass instance">
#?niecza skip 'method ^foo'
{
class T1 {
our $c = 0;
method ^count($obj) { #OK not used
return $c;
}
method mi { ++$c };
method md { --$c };
}
my ($a, $b, $c) = map { T1.new() }, 1..3;
is $c.mi, 1, 'can increment class variable in instance method';
is $b.mi, 2, '.. and the class variable is really shared';
#?rakudo 6 skip 'nom regression - method ^foo'
is $a.count, 2, 'can call the class method on an object';
is T1.count, 2, '... and on the proto object';
is T1.^count, 2, '... and on the proto object with Class.^method';
is $a.^count, 2, '... and $obj.^method';
is T1.HOW.count(T1), 2, '... and by explicitly using .HOW with proto object';
is $a.HOW.count($a), 2, '... and by explicitly using .HOW with instance';
}
{
class Oof {
my $.x;
}
my $x = Oof.new();
$x.x = 42;
is($x.x, 42, "class attribute accessors work");
my $y = Oof.new();
is($y.x, 42, "class attributes shared by all instances");
}
# RT#122087
{
class Woof {
my $.x = 'yap';
}
my $x = Woof.new();
is($x.x, 'yap', "class attribute initialization works");
}
# RT #57336
#?niecza skip 'Exception'
{
# TODO: Test that the exceptions thrown here are the right ones
# and not the result of some other bug.
my $bad_code;
$bad_code = '$.a';
try EVAL $bad_code;
ok $! ~~ Exception, "bad code: '$bad_code'";
$bad_code ='$!a';
try EVAL $bad_code;
ok $! ~~ Exception, "bad code: '$bad_code'";
$bad_code = 'class B0rk { has $.a; say $.a; }';
try EVAL $bad_code;
ok $! ~~ Exception, "bad code: '$bad_code'";
$bad_code = 'class Chef { my $.a; say $.a; }';
try EVAL $bad_code;
ok $! ~~ Exception, "bad code: '$bad_code'";
}
# RT #114230
{
class RT114230 {
has &!x;
method f {
&!x //= { 'ook!' };
my $res = defined &!x;
&!x();
}
}
lives_ok { RT114230.new.f },
'no Null PMC access when doing //= on an undefined attribute and then calling it';
}
#?niecza skip "Two definitions of method b"
{
class A {
has $.b = 1;
method b() { 2; }
};
is A.new.b, 2, "don't create accessor if the class declares an explicit method of that name";
role B {
has $.b = 1;
method b() { 2; }
};
is B.new.b, 2;
}
# RT #102478
{
class RT102478_1 { BEGIN EVAL q[has $.x] };
is RT102478_1.new(x => 3).x, 3,
'can declare attribute inside of a BEGIN EVAL in class';
class RT102478_2 { EVAL q[has $.x] };
throws_like { RT102478_2.new(x => 3).x },
X::Method::NotFound,
'cannot declare attribute inside of an EVAL in class';
}
# vim: ft=perl6