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
|
#!/usr/bin/perl -w
use strict;
use Benchmark qw(cmpthese);
use CGI::Ex::Dump qw(debug);
my $n = 500_000;
{
package A;
our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
my $meth = ($AUTOLOAD =~ /::(\w+)$/) ? $1 : die "Bad method $AUTOLOAD";
die "Unknown property $meth" if ! exists $self->{$meth};
if ($#_ != -1) {
$self->{$meth} = shift;
} else {
return $self->{$meth}
}
}
sub DETROY {}
}
{
package B;
sub add_property {
my $self = shift;
my $prop = shift;
no strict 'refs';
* {"B::$prop"} = sub {
my $self = shift;
if ($#_ != -1) {
$self->{$prop} = shift;
} else {
return $self->{$prop};
}
};
$self->$prop(@_) if $#_ != -1;
}
}
{
package C;
sub add_property {
my $self = shift;
my $prop = shift;
no strict 'refs';
my $name = __PACKAGE__ ."::". $prop;
*$name = sub : lvalue {
my $self = shift;
$self->{$prop} = shift() if $#_ != -1;
$self->{$prop};
} if ! defined &$name;
$self->$prop() = shift() if $#_ != -1;
}
}
my $a = bless {}, 'A';
$a->{foo} = 1;
#debug $a->foo();
#$a->foo(2);
#debug $a->foo();
my $b = bless {}, 'B';
$b->add_property('foo', 1);
#debug $b->foo();
#$b->foo(2);
#debug $b->foo();
my $c = bless {}, 'C';
$c->add_property('foo', 1);
#debug $c->foo();
#$c->foo(2);
#debug $c->foo();
my $d = bless {}, 'C';
$d->add_property('foo', 1);
#debug $d->foo();
#$d->foo = 2;
#debug $d->foo();
use constant do_set => 1;
cmpthese($n, {
autoloadonly => sub {
my $v = $a->foo();
if (do_set) {
$a->foo(2);
}
},
addproperty => sub {
my $v = $b->foo();
if (do_set) {
$b->foo(2);
}
},
addproperty_withlvalue => sub {
my $v = $c->foo();
if (do_set) {
$c->foo(2);
}
},
addproperty_withlvalue2 => sub {
my $v = $d->foo();
if (do_set) {
$d->foo = 2;
}
},
});
|
