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
|
#!/usr/bin/perl
use v5.18;
use warnings;
use Test2::V0 0.000148; # is_refcount
use Object::Pad 0.800;
class Point {
BUILD { @$self = @_; }
method where { sprintf "(%d,%d)", @$self }
method classname { return __CLASS__ }
}
{
my $p = Point->new( 10, 20 );
is_oneref( $p, '$p has refcount 1 initially' );
is( $p->where, "(10,20)", '$p->where' );
is_oneref( $p, '$p has refcount 1 after method' );
is( $p->classname, "Point", '__CLASS__ inside method' );
}
# anon methods
{
class Point3 {
BUILD { @$self = @_; }
our $clearer = method {
@$self = ( 0 ) x 3;
};
}
my $p = Point3->new( 1, 2, 3 );
$p->$Point3::clearer();
is( [ @$p ], [ 0, 0, 0 ],
'anon method' );
}
# nested anon method (RT132321)
SKIP: {
skip "This causes SEGV on perl 5.16 (RT132321)", 1 if $^V lt v5.18;
class RT132321 {
field $_genvalue;
BUILD {
$_genvalue = method { 123 };
}
method value { $self->$_genvalue() }
}
my $obj = RT132321->new;
is( $obj->value, 123, '$obj->value from BUILD-generated anon method' );
}
# method warns about redeclared $self (RT132428)
{
class RT132428 {
BEGIN {
my $warnings = "";
local $SIG{__WARN__} = sub { $warnings .= join "", @_; };
::ok( defined eval <<'EOPERL',
method test {
my $self = shift;
}
1;
EOPERL
'method compiles OK' );
::like( $warnings,
qr/^"my" variable \$self masks earlier declaration in same scope at \(eval \d+\) line 2\./,
'warning from redeclared $self comes from correct line' );
}
}
}
done_testing;
|
