root/lang/perl/Shika/trunk/benchmark/new-get-set.pl @ 25792

Revision 25792, 4.2 kB (checked in by gfx, 6 years ago)

change repeat count to -1

Line 
1use strict;
2use warnings;
3
4{
5    package MooseImmutableBuild;
6    use Moose;
7
8    has userid => (
9        is => 'rw',
10    );
11
12    has agent  => (
13        is => 'rw',
14        required => 1,
15    );
16
17    sub BUILD {
18        my $self = shift;
19        $self->userid(90);
20        $self->userid($self->agent->user_id ) unless $self->agent->is_non_mobile;
21    }
22
23    no Moose;
24    __PACKAGE__->meta->make_immutable;
25    1;
26}
27
28{
29    package MooseImmutableDefault;
30    use Moose;
31
32    has userid => (
33        is      => 'rw',
34        lazy    => 1,
35        default => sub {
36            my $self = shift;
37            return $self->agent->is_non_mobile ? 90 : $self->agent->user_id;
38        }
39    );
40
41    has agent  => (
42        is       => 'rw',
43        required => 1,
44    );
45
46    no Moose;
47    __PACKAGE__->meta->make_immutable;
48    1;
49}
50
51{
52    package MouseImmutableDefault;
53    use Mouse;
54
55    has userid => (
56        is      => 'rw',
57        lazy    => 1,
58        default => sub {
59            my $self = shift;
60            return $self->agent->is_non_mobile ? 90 : $self->agent->user_id;
61        }
62    );
63
64    has agent  => (
65        is       => 'rw',
66        required => 1,
67    );
68
69    no Mouse;
70    __PACKAGE__->meta->make_immutable;
71    1;
72}
73
74{
75    package MouseDefault;
76    use Mouse;
77
78    has userid => (
79        is      => 'rw',
80        lazy    => 1,
81        default => sub {
82            my $self = shift;
83            return $self->agent->is_non_mobile ? 90 : $self->agent->user_id;
84        }
85    );
86
87    has agent  => (
88        is       => 'rw',
89        required => 1,
90    );
91
92    no Mouse;
93    1;
94}
95
96{
97    package ShikaDefault;
98    use Shika;
99
100    has userid => (
101        is      => 'rw',
102        lazy    => 1,
103        default => sub {
104            my $self = shift;
105            return $self->agent->is_non_mobile ? 90 : $self->agent->user_id;
106        }
107    );
108
109    has agent  => (
110        is       => 'rw',
111        required => 1,
112    );
113
114    no Shika;
115    1;
116}
117
118{
119    package ClassAccessor;
120    use strict;
121    use warnings;
122    use base qw/Class::Accessor::Fast/;
123    use Carp qw/croak/;
124
125    __PACKAGE__->mk_accessors(qw/
126        userid
127        agent
128    /);
129
130    sub new {
131        my $self = shift->SUPER::new(@_);
132        $self->agent or croak 'agent not found';
133        $self->userid( 90 );
134        $self->userid( $self->agent->user_id ) unless $self->agent->is_non_mobile;
135        return $self;
136    }
137}
138
139{
140    package Popo;
141    sub new {
142        my $class = shift;
143        my $param = ref $_[0] eq 'HASH' ? shift : {@_};
144        return bless $param, ref $class || $class;
145    }
146
147    sub agent {
148        my $self = shift;
149        return $self->{agent} = shift if @_;
150        return $self->{agent};
151    }
152
153    sub userid {
154        my $self = shift;
155        return $self->{userid} = shift if @_;
156        exists $self->{userid} || do {
157            $self->{userid} = $self->agent->is_non_mobile ? 90 : $self->agent->user_id;
158        };
159        return $self->{userid};
160    }
161}
162
163package main;
164
165use HTTP::MobileAgent;
166my $agent = HTTP::MobileAgent->new('');
167
168use Benchmark qw(cmpthese timethese :hireswallclock);
169
170#    my $obj1 = MooseBuild->new( agent => $agent );
171#    my $obj2 = MooseDefault->new( agent => $agent );
172#    my $obj3 = ClassAccessor->new({ agent => $agent });
173#    my $obj4 = Popo->new( agent => $agent );
174#    my $obj5 = ShikaDefault->new( agent => $agent );
175
176{
177    no strict 'refs';
178    for my $key (qw/Moose Class::MOP Mouse Shika/) {
179        my $version = ${"$key\::VERSION"};
180        print "$key: $version\n";
181    }
182}
183
184my @classes = qw/MooseImmutableBuild MooseImmutableDefault MouseImmutableDefault MouseDefault ShikaDefault ClassAccessor Popo/;
185
186print "------ new,get,set\n";
187cmpthese(-1,{
188    map { my $x = $_; $_ => sub {
189        my $obj = $x->new( {agent => $agent} );
190        $obj->userid;
191        $obj->userid('hoge');
192    }} @classes
193});
194print "------ new\n";
195cmpthese(-1,{
196    map { my $x = $_; $_ => sub {
197        $x->new( {agent => $agent} );
198    }} @classes
199});
200print "------ new,get\n";
201cmpthese(-1,{
202    map { my $x = $_; $_ => sub {
203        my $obj = $x->new( {agent => $agent} );
204        $obj->userid();
205    }} @classes
206});
207print "----1 new,set\n";
208cmpthese(10000,{
209    map { my $x = $_; $_ => sub {
210        my $obj = $x->new( {agent => $agent} );
211        $obj->userid('hoge');
212    }} @classes
213});
Note: See TracBrowser for help on using the browser.