r5776 - in /packages/libclass-accessor-perl/branches/upstream/current: Changes META.yml README examples/benchmark lib/Class/Accessor.pm lib/Class/Accessor/Fast.pm lib/Class/Accessor/Faster.pm t/accessors.t

gregoa-guest at users.alioth.debian.org gregoa-guest at users.alioth.debian.org
Sat Jul 14 20:05:09 UTC 2007


Author: gregoa-guest
Date: Sat Jul 14 20:05:08 2007
New Revision: 5776

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=5776
Log:
[svn-upgrade] Integrating new upstream version, libclass-accessor-perl (0.31)

Modified:
    packages/libclass-accessor-perl/branches/upstream/current/Changes
    packages/libclass-accessor-perl/branches/upstream/current/META.yml
    packages/libclass-accessor-perl/branches/upstream/current/README
    packages/libclass-accessor-perl/branches/upstream/current/examples/benchmark
    packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor.pm
    packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor/Fast.pm
    packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor/Faster.pm
    packages/libclass-accessor-perl/branches/upstream/current/t/accessors.t

Modified: packages/libclass-accessor-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-accessor-perl/branches/upstream/current/Changes?rev=5776&op=diff
==============================================================================
--- packages/libclass-accessor-perl/branches/upstream/current/Changes (original)
+++ packages/libclass-accessor-perl/branches/upstream/current/Changes Sat Jul 14 20:05:08 2007
@@ -1,3 +1,6 @@
+0.31 Wed Jul 11 23:03:47 JST 2007
+    - applied performance patch from RUZ
+
 0.30 Sun Nov 26 13:03:47 JST 2006
     - added version numbers back into each class to fix RT#21746
 

Modified: packages/libclass-accessor-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-accessor-perl/branches/upstream/current/META.yml?rev=5776&op=diff
==============================================================================
--- packages/libclass-accessor-perl/branches/upstream/current/META.yml (original)
+++ packages/libclass-accessor-perl/branches/upstream/current/META.yml Sat Jul 14 20:05:08 2007
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Class-Accessor
-version:      0.30
+version:      0.31
 version_from: lib/Class/Accessor.pm
 installdirs:  site
 requires:

Modified: packages/libclass-accessor-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-accessor-perl/branches/upstream/current/README?rev=5776&op=diff
==============================================================================
--- packages/libclass-accessor-perl/branches/upstream/current/README (original)
+++ packages/libclass-accessor-perl/branches/upstream/current/README Sat Jul 14 20:05:08 2007
@@ -46,10 +46,27 @@
 
     Done. My::Class now has simple foo(), bar() and car() accessors defined.
 
+BENCHMARKS
+
+    accessors:
+                 Rate   Basic Average    Fast  Faster  Direct
+    Basic    189150/s      --    -42%    -51%    -55%    -89%
+    Average  327679/s     73%      --    -16%    -22%    -82%
+    Fast     389212/s    106%     19%      --     -8%    -78%
+    Faster   421646/s    123%     29%      8%      --    -76%
+    Direct  1771243/s    836%    441%    355%    320%      --
+
+    mutators:
+                 Rate   Basic Average    Fast  Faster  Direct
+    Basic    173769/s      --    -34%    -53%    -59%    -90%
+    Average  263046/s     51%      --    -29%    -38%    -85%
+    Fast     371158/s    114%     41%      --    -13%    -78%
+    Faster   425821/s    145%     62%     15%      --    -75%
+    Direct  1699081/s    878%    546%    358%    299%      --
 
 AUTHORS
 
-    Copyright 2006 Marty Pauley <marty+perl at kasei.com>
+    Copyright 2007 Marty Pauley <marty+perl at kasei.com>
 
     This program is free software; you can redistribute it and/or modify it
     under the same terms as Perl itself. That means either (a) the GNU

Modified: packages/libclass-accessor-perl/branches/upstream/current/examples/benchmark
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-accessor-perl/branches/upstream/current/examples/benchmark?rev=5776&op=diff
==============================================================================
--- packages/libclass-accessor-perl/branches/upstream/current/examples/benchmark (original)
+++ packages/libclass-accessor-perl/branches/upstream/current/examples/benchmark Sat Jul 14 20:05:08 2007
@@ -49,22 +49,25 @@
 use Benchmark 'cmpthese';
 use strict;
 
+print "accessors:\n";
 cmpthese( -1, 
            {
-            'C::A - get' => sub { $foo = $ca->test; },
-            'C::A::F - get' => sub { $foo = $fast->test; },
-            'C::A::Fr - get' => sub { $foo = $faster->test; },
-            'By Hand - get' => sub { $foo = $byhand->test; },
-            'Direct - get' => sub { $foo = $direct->{test}; }
-           }
-         );
-cmpthese( -1, 
-           {
-            'C::A - set' => sub { $ca->test(42); },
-            'C::A::F - set' => sub { $fast->test(42); },
-            'C::A::Fr - set' => sub { $faster->test(42); },
-            'By Hand - set' => sub { $byhand->test(42); },
-            'Direct - set' => sub { $direct->{test} = 42; }
+            'Basic' => sub { $foo = $ca->test; },
+            'Fast' => sub { $foo = $fast->test; },
+            'Faster' => sub { $foo = $faster->test; },
+            'Average' => sub { $foo = $byhand->test; },
+            'Direct' => sub { $foo = $direct->{test}; }
            }
          );
 
+print "mutators:\n";
+cmpthese( -1, 
+           {
+            'Acc' => sub { $ca->test(42); },
+            'Fast' => sub { $fast->test(42); },
+            'Faster' => sub { $faster->test(42); },
+            'By hand' => sub { $byhand->test(42); },
+            'Direct' => sub { $direct->{test} = 42; }
+           }
+         );
+

Modified: packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor.pm?rev=5776&op=diff
==============================================================================
--- packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor.pm (original)
+++ packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor.pm Sat Jul 14 20:05:08 2007
@@ -1,7 +1,7 @@
 package Class::Accessor;
 require 5.00502;
 use strict;
-$Class::Accessor::VERSION = '0.30';
+$Class::Accessor::VERSION = '0.31';
 
 =head1 NAME
 
@@ -477,42 +477,40 @@
 than you'd think.  Its generated methods incur no special penalty over
 ones you'd write yourself.
 
-Here are Schwern's results of benchmarking Class::Accessor,
-Class::Accessor::Fast, a hand-written accessor, and direct hash access.
-
-  Benchmark: timing 500000 iterations of By Hand - get, By Hand - set, 
-    C::A - get, C::A - set, C::A::Fast - get, C::A::Fast - set, 
-    Direct - get, Direct - set...
-
-  By Hand - get:  4 wallclock secs ( 5.09 usr +  0.00 sys =  5.09 CPU) 
-                  @ 98231.83/s (n=500000)
-  By Hand - set:  5 wallclock secs ( 6.06 usr +  0.00 sys =  6.06 CPU) 
-                  @ 82508.25/s (n=500000)
-  C::A - get:  9 wallclock secs ( 9.83 usr +  0.01 sys =  9.84 CPU) 
-               @ 50813.01/s (n=500000)
-  C::A - set: 11 wallclock secs ( 9.95 usr +  0.00 sys =  9.95 CPU) 
-               @ 50251.26/s (n=500000)
-  C::A::Fast - get:  6 wallclock secs ( 4.88 usr +  0.00 sys =  4.88 CPU) 
-                     @ 102459.02/s (n=500000)
-  C::A::Fast - set:  6 wallclock secs ( 5.83 usr +  0.00 sys =  5.83 CPU) 
-                     @ 85763.29/s (n=500000)
-  Direct - get:  0 wallclock secs ( 0.89 usr +  0.00 sys =  0.89 CPU) 
-                 @ 561797.75/s (n=500000)
-  Direct - set:  2 wallclock secs ( 0.87 usr +  0.00 sys =  0.87 CPU) 
-                 @ 574712.64/s (n=500000)
-
-So Class::Accessor::Fast is just as fast as one you'd write yourself
-while Class::Accessor is twice as slow, a price paid for flexibility.
-Direct hash access is about six times faster, but provides no
-encapsulation and no flexibility.
-
-Of course, its not as simple as saying "Class::Accessor is twice as
-slow as one you write yourself".  These are benchmarks for the
-simplest possible accessor, if your accessors do any sort of
-complicated work (such as talking to a database or writing to a file)
-the time spent doing that work will quickly swamp the time spend just
-calling the accessor.  In that case, Class::Accessor and the ones you
-write will tend to be just as fast.
+  accessors:
+               Rate   Basic Average    Fast  Faster  Direct
+  Basic    189150/s      --    -42%    -51%    -55%    -89%
+  Average  327679/s     73%      --    -16%    -22%    -82%
+  Fast     389212/s    106%     19%      --     -8%    -78%
+  Faster   421646/s    123%     29%      8%      --    -76%
+  Direct  1771243/s    836%    441%    355%    320%      --
+
+  mutators:
+               Rate   Basic Average    Fast  Faster  Direct
+  Basic    173769/s      --    -34%    -53%    -59%    -90%
+  Average  263046/s     51%      --    -29%    -38%    -85%
+  Fast     371158/s    114%     41%      --    -13%    -78%
+  Faster   425821/s    145%     62%     15%      --    -75%
+  Direct  1699081/s    878%    546%    358%    299%      --
+
+Class::Accessor::Fast is faster than methods written by an average programmer
+(where "average" is based on Schwern's example code).
+
+Class::Accessor is slower than average, but more flexible.
+
+Class::Accessor::Faster is even faster than Class::Accessor::Fast.  It uses an
+array internally, not a hash.  This could be a good or bad feature depending on
+your point of view.
+
+Direct hash access is, of course, much faster than all of these, but it
+provides no encapsulation.
+
+Of course, its not as simple as saying "Class::Accessor is slower than
+average".  These are benchmarks for a simple accessor.  If your accessors do
+any sort of complicated work (such as talking to a database or writing to a
+file) the time spent doing that work will quickly swamp the time spend just
+calling the accessor.  In that case, Class::Accessor and the ones you write
+will be roughly the same speed.
 
 
 =head1 EXAMPLES
@@ -645,7 +643,7 @@
 
 =head1 AUTHORS
 
-Copyright 2005 Marty Pauley <marty+perl at kasei.com>
+Copyright 2007 Marty Pauley <marty+perl at kasei.com>
 
 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.  That means either (a) the GNU General Public
@@ -657,7 +655,7 @@
 
 =head2 THANKS
 
-Liz, for performance tweaks.
+Liz and RUZ for performance tweaks.
 
 Tels, for his big feature request/bug report.
 

Modified: packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor/Fast.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor/Fast.pm?rev=5776&op=diff
==============================================================================
--- packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor/Fast.pm (original)
+++ packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor/Fast.pm Sat Jul 14 20:05:08 2007
@@ -1,7 +1,7 @@
 package Class::Accessor::Fast;
 use base 'Class::Accessor';
 use strict;
-$Class::Accessor::Fast::VERSION = '0.30';
+$Class::Accessor::Fast::VERSION = '0.31';
 
 =head1 NAME
 
@@ -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;
+        return (shift)->{$field} = \@_;
     };
 }
 
@@ -46,10 +46,9 @@
     my($class, $field) = @_;
 
     return sub {
-        return $_[0]->{$field} unless @_ > 1;
-        my $self = shift;
+        return $_[0]->{$field} if @_ == 1;
         my $caller = caller;
-        $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
+        $_[0]->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
     };
 }
 
@@ -58,14 +57,13 @@
     my($class, $field) = @_;
 
     return sub {
-        my $self = shift;
-
-        unless (@_) {
+        if (@_ == 1) {
             my $caller = caller;
-            $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
+            $_[0]->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
         }
         else {
-            return $self->{$field} = (@_ == 1 ? $_[0] : [@_]);
+            return $_[0]->{$field} = $_[1] if @_ == 2;
+            return (shift)->{$field} = \@_;
         }
     };
 }
@@ -77,7 +75,7 @@
 
 =head1 AUTHORS
 
-Copyright 2005 Marty Pauley <marty+perl at kasei.com>
+Copyright 2007 Marty Pauley <marty+perl at kasei.com>
 
 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.  That means either (a) the GNU General Public

Modified: packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor/Faster.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor/Faster.pm?rev=5776&op=diff
==============================================================================
--- packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor/Faster.pm (original)
+++ packages/libclass-accessor-perl/branches/upstream/current/lib/Class/Accessor/Faster.pm Sat Jul 14 20:05:08 2007
@@ -1,7 +1,7 @@
 package Class::Accessor::Faster;
 use base 'Class::Accessor';
 use strict;
-$Class::Accessor::Faster::VERSION = '0.30';
+$Class::Accessor::Faster::VERSION = '0.31';
 
 =head1 NAME
 
@@ -55,9 +55,9 @@
     my($class, $field) = @_;
     my $n = $class->_slot($field);
     return sub {
-        return $_[0]->[$n] unless @_ > 1;
-        my $self = shift;
-        $self->[$n] = (@_ == 1 ? $_[0] : [@_]);
+        return $_[0]->[$n] if @_ == 1;
+        return $_[0]->[$n] = $_[1] if @_ == 2;
+        return (shift)->[$n] = \@_;
     };
 }
 
@@ -66,10 +66,9 @@
     my($class, $field) = @_;
     my $n = $class->_slot($field);
     return sub {
-        return $_[0]->[$n] unless @_ > 1;
-        my $self = shift;
+        return $_[0]->[$n] if @_ == 1;
         my $caller = caller;
-        $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
+        $_[0]->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
     };
 }
 
@@ -78,14 +77,12 @@
     my($class, $field) = @_;
     my $n = $class->_slot($field);
     return sub {
-        my $self = shift;
-
-        unless (@_) {
+        if (@_ == 1) {
             my $caller = caller;
-            $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
-        }
-        else {
-            return $self->[$n] = (@_ == 1 ? $_[0] : [@_]);
+            $_[0]->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
+        } else {
+            return $_[0]->[$n] = $_[1] if @_ == 2;
+            return (shift)->[$n] = \@_;
         }
     };
 }
@@ -93,7 +90,7 @@
 
 =head1 AUTHORS
 
-Copyright 2006 Marty Pauley <marty+perl at kasei.com>
+Copyright 2007 Marty Pauley <marty+perl at kasei.com>
 
 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.  That means either (a) the GNU General Public

Modified: packages/libclass-accessor-perl/branches/upstream/current/t/accessors.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-accessor-perl/branches/upstream/current/t/accessors.t?rev=5776&op=diff
==============================================================================
--- packages/libclass-accessor-perl/branches/upstream/current/t/accessors.t (original)
+++ packages/libclass-accessor-perl/branches/upstream/current/t/accessors.t Sat Jul 14 20:05:08 2007
@@ -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 };




More information about the Pkg-perl-cvs-commits mailing list