| Subject: | Performance improvement for C::A::Fast |
Hello.
I'm suggesting father performance improvement in ::Fast accessors. In
attached script is a benchmark test that shows 15-20% improvement in the
set operation with scalar argument and more than 50% with arrays. Get
operation shows speed up close to 5%, but I think that's a noise of the
benchmark.
So I'm proposing a patch which is attached to the ticket. As well patch
adds several tests that brings test coverage of the fast module to 100%.
--
Best regards, Ruslan.
| Subject: | c-a-f-performance.patch |
ТолÑко в Class-Accessor-0.30-my/: Class-Accessor-0.30.tar.gz
diff -ru Class-Accessor-0.30/lib/Class/Accessor/Fast.pm Class-Accessor-0.30-my/lib/Class/Accessor/Fast.pm
--- Class-Accessor-0.30/lib/Class/Accessor/Fast.pm 2006-11-26 07:09:17.000000000 +0300
+++ Class-Accessor-0.30-my/lib/Class/Accessor/Fast.pm 2007-02-01 21:03:59.000000000 +0300
@@ -35,9 +35,9 @@
my($class, $field) = @_;
return sub {
- return $_[0]->{$field} unless @_ > 1;
- my $self = shift;
- $self->{$field} = (@_ == 1 ? $_[0] : [@_]);
+ return $_[0]->{$field} if @_ == 1;
+ return $_[0]->{$field} = $_[1] if @_ == 2;
+ (shift)->{$field} = \@_;
};
}
ТолÑко в Class-Accessor-0.30-my/: Makefile.old
diff -ru Class-Accessor-0.30/t/accessors.t Class-Accessor-0.30-my/t/accessors.t
--- Class-Accessor-0.30/t/accessors.t 2006-11-26 07:09:17.000000000 +0300
+++ Class-Accessor-0.30-my/t/accessors.t 2007-02-02 00:57:00.000000000 +0300
@@ -1,6 +1,6 @@
#!perl
use strict;
-use Test::More tests => 37;
+use Test::More tests => 42;
for my $class (qw(Class::Accessor Class::Accessor::Fast Class::Accessor::Faster)) {
require_ok($class);
@@ -54,6 +54,14 @@
my @args = ($test2->foo, $test2->bar);
is(@args, 2, 'accessor get in list context');
+ # test array setters
+ $test->foo(qw(1 2 3));
+ is_deeply($test->foo, [qw(1 2 3)], "set an array ref via foo accessor");
+
+ $test->sekret(qw(1 2 3));
+ is_deeply($test->{'sekret'}, [qw(1 2 3)], "array ref")
+ unless $class eq 'Class::Accessor::Faster';
+
{
my $eeek;
local $SIG{__WARN__} = sub { $eeek = shift };
| Subject: | fastest_accessor.pl |
#!/usr/bin/perl
use warnings FATAL => 'all';
use strict;
use Benchmark qw(cmpthese);
my @arr = (0..3);
my $cur = new Current;
my $my = new My;
my $faster = new Faster;
cmpthese(-5, {
cur_get => sub { $cur->foo },
my_get => sub { $my->foo },
fas_get => sub { $faster->foo },
});
cmpthese(-5, {
cur_set => sub { $cur->foo('set') },
my_set => sub { $my->foo('set') },
fas_set => sub { $faster->foo('set') },
});
cmpthese(-5, {
cur_set_a => sub { $cur->foo(qw(1 2 3)) },
my_set_a => sub { $my->foo(qw(1 2 3)) },
fas_set_a => sub { $faster->foo(qw(1 2 3)) },
});
package Current;
sub new { return bless {}, shift }
BEGIN {
use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors('foo'); }
package My;
sub new { return bless {}, shift }
sub make_accessor {
my($field) = @_;
return sub {
return $_[0]->{$field} if @_ == 1;
return $_[0]->{$field} = $_[1] if @_ == 2;
(shift)->{$field} = \@_;
};
}
BEGIN { no strict 'refs'; *{'My::foo'} = make_accessor('foo'); }
package Faster;
sub new { return bless [], shift }
BEGIN {
use base qw(Class::Accessor::Faster);
__PACKAGE__->mk_accessors('foo'); }