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
|
#!./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 Test1 {
method retself { return $self }
}
my $obj = Test1->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 Test2 {
method retfirst ( $x = 123 ) { return $x; }
}
my $obj = Test2->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 Test3 {
my $count;
method inc { return $count++ }
}
my $obj1 = Test3->new;
$obj1->inc;
is($obj1->inc, 1, '$obj1->inc sees 1');
my $obj2 = Test3->new;
is($obj2->inc, 2, '$obj2->inc sees 2');
}
# $self is shifted from @_
{
class Test4 {
method args { return @_ }
}
my $obj = Test4->new;
ok(eq_array([$obj->args("a", "b")], ["a", "b"]), '$self is shifted from @_');
}
# anon methods
{
class Test5 {
method anonmeth {
return method {
return "Result";
}
}
}
my $obj = Test5->new;
my $mref = $obj->anonmeth;
is($obj->$mref, "Result", 'anon method can be invoked');
}
# methods can be forward declared without a body
{
class Test6 {
method forwarded;
method forwarded { return "OK" }
}
is(Test6->new->forwarded, "OK", 'forward-declared method works');
}
done_testing;
|
