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
|
#!./perl
BEGIN {
chdir 't' if -d 't';
require './test.pl';
set_up_inc('../lib');
require Config;
}
use v5.36;
use feature 'class';
no warnings 'experimental::class';
# $self in method
{
class Testcase1 {
method retself { return $self }
}
my $obj = Testcase1->new;
is($obj->retself, $obj, '$self inside method');
}
# methods have signatures; signatures do not capture $self
{
# Turn off the 'signatures' feature to prove that 'method' is always
# signatured even without it
no feature 'signatures';
class Testcase2 {
method retfirst ( $x = 123 ) { return $x; }
}
my $obj = Testcase2->new;
is($obj->retfirst, 123, 'method signature params work');
is($obj->retfirst(456), 456, 'method signature params skip $self');
}
# methods can still capture regular package lexicals
{
class Testcase3 {
my $count;
method inc { return $count++ }
}
my $obj1 = Testcase3->new;
$obj1->inc;
is($obj1->inc, 1, '$obj1->inc sees 1');
my $obj2 = Testcase3->new;
is($obj2->inc, 2, '$obj2->inc sees 2');
}
# $self is shifted from @_
{
class Testcase4 {
method args { return @_ }
}
my $obj = Testcase4->new;
ok(eq_array([$obj->args("a", "b")], ["a", "b"]), '$self is shifted from @_');
}
# anon methods
{
class Testcase5 {
method anonmeth {
return method {
return "Result";
}
}
}
my $obj = Testcase5->new;
my $mref = $obj->anonmeth;
is($obj->$mref, "Result", 'anon method can be invoked');
}
# methods can be forward declared without a body
{
class Testcase6 {
method forwarded;
method forwarded { return "OK" }
}
is(Testcase6->new->forwarded, "OK", 'forward-declared method works');
}
# methods can be declared lexically
{
class Testcase7 {
my method priv {
return "private-result";
}
method m { return priv($self); }
}
is(Testcase7->new->m, "private-result", 'lexical method can be declared and called');
ok(!Testcase7->can("priv"), 'lexical method does not appear in the symbol table');
}
# ->& operator can invoke methods with lexical scope
{
class Testcase8 {
field $f = "private-result";
my method priv {
return $f;
}
method notpriv {
return "pkg-result";
}
method lexm_paren { return $self->&priv(); }
method lexm_plain { return $self->&priv; }
method pkgm { return $self->¬priv; }
}
is(Testcase8->new->lexm_paren, "private-result", 'lexical method can be invoked with ->&m()');
is(Testcase8->new->lexm_plain, "private-result", 'lexical method can be invoked with ->&m');
is(Testcase8->new->pkgm, "pkg-result", 'package method can be invoked with ->&m');
class Testcase8Derived :isa(Testcase8) {
method notpriv {
return "different result";
}
}
is(Testcase8Derived->new->pkgm, "pkg-result",
'->&m operator does not follow inheritance');
}
# lexical methods with signatures work correctly (GH#23030)
{
class Testcase9 {
field $x = 123;
my method priv ( $y ) {
return "X is $x and Y is $y for $self";
}
method test {
$self->&priv(456);
}
}
like(Testcase9->new->test, qr/^X is 123 and Y is 456 for Testcase9=OBJECT\(0x.*\)$/,
'lexical method with signature counts $self correctly');
}
done_testing;
|
