r61589 - in /branches/upstream/libclass-xsaccessor-perl/current: ./ XS/ author_scripts/ lib/Class/ lib/Class/XSAccessor/ t/
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sun Aug 15 06:34:50 UTC 2010
Author: ansgar-guest
Date: Sun Aug 15 06:34:29 2010
New Revision: 61589
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=61589
Log:
[svn-upgrade] new version libclass-xsaccessor-perl (1.06)
Added:
branches/upstream/libclass-xsaccessor-perl/current/author_scripts/
branches/upstream/libclass-xsaccessor-perl/current/author_scripts/benchmark.pl
Modified:
branches/upstream/libclass-xsaccessor-perl/current/Changes
branches/upstream/libclass-xsaccessor-perl/current/MANIFEST
branches/upstream/libclass-xsaccessor-perl/current/META.yml
branches/upstream/libclass-xsaccessor-perl/current/Makefile.PL
branches/upstream/libclass-xsaccessor-perl/current/XS/Array.xs
branches/upstream/libclass-xsaccessor-perl/current/XS/Hash.xs
branches/upstream/libclass-xsaccessor-perl/current/XSAccessor.xs
branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor.pm
branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor/Array.pm
branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor/Heavy.pm
branches/upstream/libclass-xsaccessor-perl/current/t/08hash_entersub.t
Modified: branches/upstream/libclass-xsaccessor-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/Changes?rev=61589&op=diff
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/Changes (original)
+++ branches/upstream/libclass-xsaccessor-perl/current/Changes Sun Aug 15 06:34:29 2010
@@ -1,4 +1,10 @@
Revision history for Perl extension Class-XSAccessor.
+
+1.06 Sat Aug 14 20:21 2010
+ - Add sanity checks in the optimized (5.10 and up)
+ implementations to make sure we don't segfault on
+ $not_a_hashref->accessor
+ (Chocolateboy
1.05 Sun Nov 15 12:54 2009
- Minor developer doc tweaks.
Modified: branches/upstream/libclass-xsaccessor-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/MANIFEST?rev=61589&op=diff
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/MANIFEST (original)
+++ branches/upstream/libclass-xsaccessor-perl/current/MANIFEST Sun Aug 15 06:34:29 2010
@@ -1,5 +1,5 @@
+author_scripts/benchmark.pl
Changes
-Class-XSAccessor-1.04_05.tar.gz
CXSAccessor.h
hash_table.h
lib/Class/XSAccessor.pm
Modified: branches/upstream/libclass-xsaccessor-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/META.yml?rev=61589&op=diff
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/META.yml (original)
+++ branches/upstream/libclass-xsaccessor-perl/current/META.yml Sun Aug 15 06:34:29 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Class-XSAccessor
-version: 1.05
+version: 1.06
abstract: Generate fast XS accessors without runtime compilation
author:
- Steffen Mueller <smueller at cpan.org>
@@ -9,13 +9,17 @@
configure_requires:
ExtUtils::MakeMaker: 0
build_requires:
- ExtUtils::MakeMaker: 0
-requires: {}
+ Test::More: 0
+requires:
+ perl: 5.008
+ XSLoader: 0
+resources:
+ repository: http://svn.ali.as/cpan/trunk/Class-XSAccessor
no_index:
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.54
+generated_by: ExtUtils::MakeMaker version 6.56
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: branches/upstream/libclass-xsaccessor-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/Makefile.PL?rev=61589&op=diff
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/Makefile.PL (original)
+++ branches/upstream/libclass-xsaccessor-perl/current/Makefile.PL Sun Aug 15 06:34:29 2010
@@ -1,35 +1,68 @@
-use 5.008;
-
-use strict;
-use warnings;
-
-use ExtUtils::MakeMaker;
-use Config;
-
-our $OPTIMIZE;
-
-if ($Config{gccversion}) {
- $OPTIMIZE = '-O3 -Wall -W';
-} elsif ($Config{osname} eq 'MSWin32') {
- $OPTIMIZE = '-O2 -W4';
-} else {
- $OPTIMIZE = $Config{optimize};
-}
-
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
- NAME => 'Class::XSAccessor',
- VERSION_FROM => 'lib/Class/XSAccessor.pm', # finds $VERSION
- PREREQ_PM => {}, # e.g., Module::Name => 1.1
- ($ExtUtils::MakeMaker::VERSION >= 6.31 ? (LICENSE => 'perl') : ()),
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'lib/Class/XSAccessor.pm', # retrieve abstract from module
- AUTHOR => 'Steffen Mueller <smueller at cpan.org>') : ()),
- LIBS => [''], # e.g., '-lm'
- DEFINE => '', # e.g., '-DHAVE_SOMETHING'
- INC => '-I.', # e.g., '-I. -I/usr/include/other'
- OPTIMIZE => $OPTIMIZE,
- # Un-comment this if you add C files to link with later:
- # OBJECT => '$(O_FILES)', # link all the C files too
-);
+use 5.008;
+
+use strict;
+use warnings;
+
+use ExtUtils::MakeMaker;
+use Config;
+
+our $OPTIMIZE;
+
+if ($Config{gccversion}) {
+ $OPTIMIZE = '-O3 -Wall -W';
+} elsif ($Config{osname} eq 'MSWin32') {
+ $OPTIMIZE = '-O2 -W4';
+} else {
+ $OPTIMIZE = $Config{optimize};
+}
+
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile1(
+ MIN_PERL_VERSION => '5.008',
+ META_MERGE => {
+ resources => {
+ repository => 'http://svn.ali.as/cpan/trunk/Class-XSAccessor',
+ },
+ },
+ BUILD_REQUIRES => {
+ 'Test::More' => 0,
+ },
+ NAME => 'Class::XSAccessor',
+ VERSION_FROM => 'lib/Class/XSAccessor.pm', # finds $VERSION
+ PREREQ_PM => {
+ 'XSLoader' => 0,
+ }, # e.g., Module::Name => 1.1
+ LICENSE => 'perl',
+ ABSTRACT_FROM => 'lib/Class/XSAccessor.pm',
+ AUTHOR => 'Steffen Mueller <smueller at cpan.org>',
+ LIBS => [''], # e.g., '-lm'
+ DEFINE => '', # e.g., '-DHAVE_SOMETHING'
+ INC => '-I.', # e.g., '-I. -I/usr/include/other'
+ OPTIMIZE => $OPTIMIZE,
+ # Un-comment this if you add C files to link with later:
+ # OBJECT => '$(O_FILES)', # link all the C files too
+);
+
+sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.20. Added by eumm-upgrade.
+ my %params=@_;
+ my $eumm_version=$ExtUtils::MakeMaker::VERSION;
+ $eumm_version=eval $eumm_version;
+ die "EXTRA_META is deprecated" if exists $params{EXTRA_META};
+ die "License not specified" if not exists $params{LICENSE};
+ if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) {
+ #EUMM 6.5502 has problems with BUILD_REQUIRES
+ $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} };
+ delete $params{BUILD_REQUIRES};
+ }
+ delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52;
+ delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48;
+ delete $params{META_MERGE} if $eumm_version < 6.46;
+ delete $params{META_ADD} if $eumm_version < 6.46;
+ delete $params{LICENSE} if $eumm_version < 6.31;
+ delete $params{AUTHOR} if $] < 5.005;
+ delete $params{ABSTRACT_FROM} if $] < 5.005;
+ delete $params{BINARY_LOCATION} if $] < 5.005;
+
+ WriteMakefile(%params);
+}
Modified: branches/upstream/libclass-xsaccessor-perl/current/XS/Array.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/XS/Array.xs?rev=61589&op=diff
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/XS/Array.xs (original)
+++ branches/upstream/libclass-xsaccessor-perl/current/XS/Array.xs Sun Aug 15 06:34:29 2010
@@ -12,6 +12,7 @@
const I32 index = CXSAccessor_arrayindices[ix];
SV** elem;
PPCODE:
+ CXA_CHECK_ARRAY(self);
CXAA_OPTIMIZE_ENTERSUB(getter);
if ((elem = av_fetch((AV *)SvRV(self), index, 1)))
PUSHs(elem[0]);
@@ -29,6 +30,7 @@
const I32 index = CXSAccessor_arrayindices[ix];
SV** elem;
PPCODE:
+ CXA_CHECK_ARRAY(self);
if ((elem = av_fetch((AV *)SvRV(self), index, 1)))
PUSHs(elem[0]);
else
@@ -45,6 +47,7 @@
* We uses it to identify the currently running alias of the accessor. Gollum! */
const I32 index = CXSAccessor_arrayindices[ix];
PPCODE:
+ CXA_CHECK_ARRAY(self);
CXAA_OPTIMIZE_ENTERSUB(setter);
if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue)))
croak("Failed to write new value to array.");
@@ -61,6 +64,7 @@
* We uses it to identify the currently running alias of the accessor. Gollum! */
const I32 index = CXSAccessor_arrayindices[ix];
PPCODE:
+ CXA_CHECK_ARRAY(self);
if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue)))
croak("Failed to write new value to array.");
PUSHs(newvalue);
@@ -76,6 +80,7 @@
* We uses it to identify the currently running alias of the accessor. Gollum! */
const I32 index = CXSAccessor_arrayindices[ix];
PPCODE:
+ CXA_CHECK_ARRAY(self);
CXAA_OPTIMIZE_ENTERSUB(chained_setter);
if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue)))
croak("Failed to write new value to array.");
@@ -92,6 +97,7 @@
* We uses it to identify the currently running alias of the accessor. Gollum! */
const I32 index = CXSAccessor_arrayindices[ix];
PPCODE:
+ CXA_CHECK_ARRAY(self);
if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue)))
croak("Failed to write new value to array.");
PUSHs(self);
@@ -107,6 +113,7 @@
const I32 index = CXSAccessor_arrayindices[ix];
SV** elem;
PPCODE:
+ CXA_CHECK_ARRAY(self);
CXAA_OPTIMIZE_ENTERSUB(accessor);
if (items > 1) {
SV* newvalue = ST(1);
@@ -132,6 +139,7 @@
const I32 index = CXSAccessor_arrayindices[ix];
SV** elem;
PPCODE:
+ CXA_CHECK_ARRAY(self);
if (items > 1) {
SV* newvalue = ST(1);
if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue)))
@@ -156,6 +164,7 @@
const I32 index = CXSAccessor_arrayindices[ix];
SV** elem;
PPCODE:
+ CXA_CHECK_ARRAY(self);
CXAA_OPTIMIZE_ENTERSUB(chained_accessor);
if (items > 1) {
SV* newvalue = ST(1);
@@ -181,6 +190,7 @@
const I32 index = CXSAccessor_arrayindices[ix];
SV** elem;
PPCODE:
+ CXA_CHECK_ARRAY(self);
if (items > 1) {
SV* newvalue = ST(1);
if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue)))
@@ -205,6 +215,7 @@
const I32 index = CXSAccessor_arrayindices[ix];
SV** elem;
PPCODE:
+ CXA_CHECK_ARRAY(self);
CXAA_OPTIMIZE_ENTERSUB(predicate);
if ( (elem = av_fetch((AV *)SvRV(self), index, 1)) && SvOK(elem[0]) )
XSRETURN_YES;
@@ -222,6 +233,7 @@
const I32 index = CXSAccessor_arrayindices[ix];
SV** elem;
PPCODE:
+ CXA_CHECK_ARRAY(self);
if ( (elem = av_fetch((AV *)SvRV(self), index, 1)) && SvOK(elem[0]) )
XSRETURN_YES;
else
Modified: branches/upstream/libclass-xsaccessor-perl/current/XS/Hash.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/XS/Hash.xs?rev=61589&op=diff
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/XS/Hash.xs (original)
+++ branches/upstream/libclass-xsaccessor-perl/current/XS/Hash.xs Sun Aug 15 06:34:29 2010
@@ -20,6 +20,7 @@
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
SV** he;
PPCODE:
+ CXA_CHECK_HASH(self);
CXAH_OPTIMIZE_ENTERSUB(getter);
if ((he = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom.key, readfrom.len, readfrom.hash)))
PUSHs(*he);
@@ -37,6 +38,7 @@
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
SV** he;
PPCODE:
+ CXA_CHECK_HASH(self);
if ((he = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom.key, readfrom.len, readfrom.hash)))
PUSHs(*he);
else
@@ -53,6 +55,7 @@
* We uses it to identify the currently running alias of the accessor. Gollum! */
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
PPCODE:
+ CXA_CHECK_HASH(self);
CXAH_OPTIMIZE_ENTERSUB(setter);
if (NULL == hv_store((HV*)SvRV(self), readfrom.key, readfrom.len, newSVsv(newvalue), readfrom.hash))
croak("Failed to write new value to hash.");
@@ -69,6 +72,7 @@
* We uses it to identify the currently running alias of the accessor. Gollum! */
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
PPCODE:
+ CXA_CHECK_HASH(self);
if (NULL == hv_store((HV*)SvRV(self), readfrom.key, readfrom.len, newSVsv(newvalue), readfrom.hash))
croak("Failed to write new value to hash.");
PUSHs(newvalue);
@@ -84,6 +88,7 @@
* We uses it to identify the currently running alias of the accessor. Gollum! */
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
PPCODE:
+ CXA_CHECK_HASH(self);
CXAH_OPTIMIZE_ENTERSUB(chained_setter);
if (NULL == hv_store((HV*)SvRV(self), readfrom.key, readfrom.len, newSVsv(newvalue), readfrom.hash))
croak("Failed to write new value to hash.");
@@ -100,6 +105,7 @@
* We uses it to identify the currently running alias of the accessor. Gollum! */
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
PPCODE:
+ CXA_CHECK_HASH(self);
if (NULL == hv_store((HV*)SvRV(self), readfrom.key, readfrom.len, newSVsv(newvalue), readfrom.hash))
croak("Failed to write new value to hash.");
PUSHs(self);
@@ -115,6 +121,7 @@
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
SV** he;
PPCODE:
+ CXA_CHECK_HASH(self);
CXAH_OPTIMIZE_ENTERSUB(accessor);
if (items > 1) {
SV* newvalue = ST(1);
@@ -140,6 +147,7 @@
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
SV** he;
PPCODE:
+ CXA_CHECK_HASH(self);
if (items > 1) {
SV* newvalue = ST(1);
if (NULL == hv_store((HV*)SvRV(self), readfrom.key, readfrom.len, newSVsv(newvalue), readfrom.hash))
@@ -164,6 +172,7 @@
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
SV** he;
PPCODE:
+ CXA_CHECK_HASH(self);
CXAH_OPTIMIZE_ENTERSUB(chained_accessor);
if (items > 1) {
SV* newvalue = ST(1);
@@ -189,6 +198,7 @@
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
SV** he;
PPCODE:
+ CXA_CHECK_HASH(self);
if (items > 1) {
SV* newvalue = ST(1);
if (NULL == hv_store((HV*)SvRV(self), readfrom.key, readfrom.len, newSVsv(newvalue), readfrom.hash))
@@ -213,6 +223,7 @@
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
SV** he;
PPCODE:
+ CXA_CHECK_HASH(self);
CXAH_OPTIMIZE_ENTERSUB(predicate);
if ( ((he = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom.key, readfrom.len, readfrom.hash))) && SvOK(*he) )
XSRETURN_YES;
@@ -230,6 +241,7 @@
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
SV** he;
PPCODE:
+ CXA_CHECK_HASH(self);
if ( ((he = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom.key, readfrom.len, readfrom.hash))) && SvOK(*he) )
XSRETURN_YES;
else
@@ -259,14 +271,14 @@
if (items > 1) {
if (!(items % 2))
- croak("Uneven number of argument to constructor.");
+ croak("Uneven number of arguments to constructor.");
for (iStack = 1; iStack < items; iStack += 2) {
- HE *he;
+ HE *he;
he = hv_store_ent(hash, ST(iStack), newSVsv(ST(iStack+1)), 0);
if (!he) {
croak("Failed to write value to hash.");
- }
+ }
}
}
PUSHs(sv_2mortal(obj));
@@ -294,14 +306,14 @@
if (items > 1) {
if (!(items % 2))
- croak("Uneven number of argument to constructor.");
+ croak("Uneven number of arguments to constructor.");
for (iStack = 1; iStack < items; iStack += 2) {
- HE *he;
+ HE *he;
he = hv_store_ent(hash, ST(iStack), newSVsv(ST(iStack+1)), 0);
if (!he) {
croak("Failed to write value to hash.");
- }
+ }
}
}
PUSHs(sv_2mortal(obj));
@@ -355,6 +367,7 @@
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
SV** he;
PPCODE:
+ CXA_CHECK_HASH(self);
warn("cxah: accessor: inside test_init");
CXAH_OPTIMIZE_ENTERSUB_TEST(test);
if (items > 1) {
@@ -381,6 +394,7 @@
const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
SV** he;
PPCODE:
+ CXA_CHECK_HASH(self);
warn("cxah: accessor: inside test");
if (items > 1) {
SV* newvalue = ST(1);
Modified: branches/upstream/libclass-xsaccessor-perl/current/XSAccessor.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/XSAccessor.xs?rev=61589&op=diff
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/XSAccessor.xs (original)
+++ branches/upstream/libclass-xsaccessor-perl/current/XSAccessor.xs Sun Aug 15 06:34:29 2010
@@ -9,6 +9,16 @@
#define CXAA(name) XS_Class__XSAccessor__Array_ ## name
#define CXAH(name) XS_Class__XSAccessor_ ## name
+
+#define CXA_CHECK_HASH(self) \
+if (!(SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV)) { \
+ croak("Class::XSAccessor: invalid instance method invocant: no hash ref supplied"); \
+}
+
+#define CXA_CHECK_ARRAY(self) \
+if (!(SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVAV)) { \
+ croak("Class::XSAccessor: invalid instance method invocant: no array ref supplied"); \
+}
/*
* chocolateboy: 2009-09-06 - 2009-11-14:
Added: branches/upstream/libclass-xsaccessor-perl/current/author_scripts/benchmark.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/author_scripts/benchmark.pl?rev=61589&op=file
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/author_scripts/benchmark.pl (added)
+++ branches/upstream/libclass-xsaccessor-perl/current/author_scripts/benchmark.pl Sun Aug 15 06:34:29 2010
@@ -1,0 +1,154 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+printf STDOUT 'perl: %s, Class::XSAccessor: %s%s', $], Class::XSAccessor->VERSION, $/;
+
+package WithClassXSAccessor;
+
+use blib;
+
+use Class::XSAccessor
+ constructor => 'new',
+ accessors => { myattr => 'myattr' },
+ getters => { get_myattr => 'myattr' },
+ setters => { set_myattr => 'myattr' },
+;
+
+package WithStdClass;
+
+sub new { my $c = shift; bless {@_}, ref($c) || $c }
+
+sub myattr {
+ my $self = shift;
+
+ if (@_) {
+ return $self->{myattr} = shift;
+ } else {
+ return $self->{myattr};
+ }
+}
+
+package WithStdClassFast;
+
+sub new { my $c = shift; bless {@_}, ref($c) || $c }
+
+sub myattr { (@_ > 1) ? $_[0]->{myattr} = $_[1] : $_[0]->{myattr} }
+
+package main;
+
+use Benchmark qw(cmpthese timethese :hireswallclock);
+# use Benchmark qw(cmpthese timethese);
+
+my $class_xs_accessor = WithClassXSAccessor->new;
+my $std_class = WithStdClass->new;
+my $std_class_fast = WithStdClassFast->new;
+my $direct_hash = {};
+my $count = shift || -2;
+
+$direct_hash->{myattr} = 42;
+$class_xs_accessor->myattr(42);
+$std_class->myattr(42);
+$std_class_fast->myattr(42);
+
+=for comment
+ direct_hash => sub {
+ $direct_hash->{myattr} = $direct_hash->{myattr};
+ $direct_hash->{myattr} = $direct_hash->{myattr};
+ $direct_hash->{myattr} = $direct_hash->{myattr};
+ $direct_hash->{myattr} = $direct_hash->{myattr};
+ $direct_hash->{myattr} = $direct_hash->{myattr};
+ $direct_hash->{myattr} = $direct_hash->{myattr};
+ $direct_hash->{myattr} = $direct_hash->{myattr};
+ $direct_hash->{myattr} = $direct_hash->{myattr};
+ $direct_hash->{myattr} = $direct_hash->{myattr};
+ $direct_hash->{myattr} = $direct_hash->{myattr};
+ die unless ($direct_hash->{myattr} == 42);
+ },
+=cut
+
+cmpthese(timethese($count, {
+ class_xs_accessor_getset => sub {
+ $class_xs_accessor->set_myattr($class_xs_accessor->get_myattr);
+ $class_xs_accessor->set_myattr($class_xs_accessor->get_myattr);
+ $class_xs_accessor->set_myattr($class_xs_accessor->get_myattr);
+ $class_xs_accessor->set_myattr($class_xs_accessor->get_myattr);
+ $class_xs_accessor->set_myattr($class_xs_accessor->get_myattr);
+ $class_xs_accessor->set_myattr($class_xs_accessor->get_myattr);
+ $class_xs_accessor->set_myattr($class_xs_accessor->get_myattr);
+ $class_xs_accessor->set_myattr($class_xs_accessor->get_myattr);
+ $class_xs_accessor->set_myattr($class_xs_accessor->get_myattr);
+ $class_xs_accessor->set_myattr($class_xs_accessor->get_myattr);
+ die unless ($class_xs_accessor->myattr == 42);
+ },
+ class_xs_accessor => sub {
+ $class_xs_accessor->myattr($class_xs_accessor->myattr);
+ $class_xs_accessor->myattr($class_xs_accessor->myattr);
+ $class_xs_accessor->myattr($class_xs_accessor->myattr);
+ $class_xs_accessor->myattr($class_xs_accessor->myattr);
+ $class_xs_accessor->myattr($class_xs_accessor->myattr);
+ $class_xs_accessor->myattr($class_xs_accessor->myattr);
+ $class_xs_accessor->myattr($class_xs_accessor->myattr);
+ $class_xs_accessor->myattr($class_xs_accessor->myattr);
+ $class_xs_accessor->myattr($class_xs_accessor->myattr);
+ $class_xs_accessor->myattr($class_xs_accessor->myattr);
+ die unless ($class_xs_accessor->myattr == 42);
+ },
+ std_class => sub {
+ $std_class->myattr($std_class->myattr);
+ $std_class->myattr($std_class->myattr);
+ $std_class->myattr($std_class->myattr);
+ $std_class->myattr($std_class->myattr);
+ $std_class->myattr($std_class->myattr);
+ $std_class->myattr($std_class->myattr);
+ $std_class->myattr($std_class->myattr);
+ $std_class->myattr($std_class->myattr);
+ $std_class->myattr($std_class->myattr);
+ $std_class->myattr($std_class->myattr);
+ die unless ($std_class->myattr == 42);
+ },
+ std_class_fast => sub {
+ $std_class_fast->myattr($std_class_fast->myattr);
+ $std_class_fast->myattr($std_class_fast->myattr);
+ $std_class_fast->myattr($std_class_fast->myattr);
+ $std_class_fast->myattr($std_class_fast->myattr);
+ $std_class_fast->myattr($std_class_fast->myattr);
+ $std_class_fast->myattr($std_class_fast->myattr);
+ $std_class_fast->myattr($std_class_fast->myattr);
+ $std_class_fast->myattr($std_class_fast->myattr);
+ $std_class_fast->myattr($std_class_fast->myattr);
+ $std_class_fast->myattr($std_class_fast->myattr);
+ die unless ($std_class_fast->myattr == 42);
+ },
+}));
+
+print "Constructor benchmark:\n";
+cmpthese(timethese($count, {
+ class_xs_accessor => sub {
+ my $obj;
+ $obj = WithClassXSAccessor->new();
+ $obj = WithClassXSAccessor->new();
+ $obj = WithClassXSAccessor->new();
+ $obj = WithClassXSAccessor->new();
+ $obj = WithClassXSAccessor->new();
+ $obj = WithClassXSAccessor->new();
+ $obj = WithClassXSAccessor->new();
+ $obj = WithClassXSAccessor->new();
+ $obj = WithClassXSAccessor->new();
+ $obj = WithClassXSAccessor->new();
+ },
+ std_class => sub {
+ my $obj;
+ $obj = WithStdClass->new();
+ $obj = WithStdClass->new();
+ $obj = WithStdClass->new();
+ $obj = WithStdClass->new();
+ $obj = WithStdClass->new();
+ $obj = WithStdClass->new();
+ $obj = WithStdClass->new();
+ $obj = WithStdClass->new();
+ $obj = WithStdClass->new();
+ $obj = WithStdClass->new();
+ },
+}));
Modified: branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor.pm?rev=61589&op=diff
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor.pm (original)
+++ branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor.pm Sun Aug 15 06:34:29 2010
@@ -7,7 +7,7 @@
use Carp qw/croak/;
-our $VERSION = '1.05';
+our $VERSION = '1.06';
require XSLoader;
XSLoader::load('Class::XSAccessor', $VERSION);
Modified: branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor/Array.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor/Array.pm?rev=61589&op=diff
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor/Array.pm (original)
+++ branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor/Array.pm Sun Aug 15 06:34:29 2010
@@ -5,7 +5,7 @@
use warnings;
use Carp qw/croak/;
-our $VERSION = '1.05';
+our $VERSION = '1.06';
require Class::XSAccessor;
require Class::XSAccessor::Heavy;
Modified: branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor/Heavy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor/Heavy.pm?rev=61589&op=diff
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor/Heavy.pm (original)
+++ branches/upstream/libclass-xsaccessor-perl/current/lib/Class/XSAccessor/Heavy.pm Sun Aug 15 06:34:29 2010
@@ -5,10 +5,10 @@
use warnings;
use Carp;
-our $VERSION = '1.05';
+our $VERSION = '1.06';
our @CARP_NOT = qw(
- Class::XSAccessor
- Class::XSAccessor::Array
+ Class::XSAccessor
+ Class::XSAccessor::Array
);
# TODO Move more duplicated code from XSA and XSA::Array here
Modified: branches/upstream/libclass-xsaccessor-perl/current/t/08hash_entersub.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-xsaccessor-perl/current/t/08hash_entersub.t?rev=61589&op=diff
==============================================================================
--- branches/upstream/libclass-xsaccessor-perl/current/t/08hash_entersub.t (original)
+++ branches/upstream/libclass-xsaccessor-perl/current/t/08hash_entersub.t Sun Aug 15 06:34:29 2010
@@ -13,7 +13,7 @@
}
use Test::More tests => 103;
-use Data::Dumper; $Data::Dumper::Terse = $Data::Dumper::Indent = 1;
+# use Data::Dumper; $Data::Dumper::Terse = $Data::Dumper::Indent = 1;
our @WARNINGS = ();
@@ -61,9 +61,9 @@
}
# dynamic with a twist: the second sub isn't a Class::XSAccessor XSUB.
-# this should a) disable the optimization for the two entersub calls
-# b) switch foo over to non-optimizing mode and c) (of course) still
-# work as expected for foo and baz. the bar accessor should still be optimizing
+# this should disable the optimization for the two entersub calls,
+# and (of course) still work as expected for foo and baz.
+# the bar accessor should still be optimizing
sub test4 {
my $self = shift;
for my $name (qw(foo baz)) {
@@ -76,7 +76,7 @@
is($self->{bar}, 'bar4');
}
-# call the methods as subs to see how this impacts the optimized entersub
+# call the methods as subs to see how this impacts the optimized entersub. XXX: passed as GVs
sub test5 {
my $self = shift;
is(foo($self, 'foo5'), 'foo5');
@@ -87,8 +87,8 @@
is($self->{bar}, 'bar5');
}
-# call the methods as subs with & - this sets a flag in the entersub's op_private
-# XXX: these are passed in as GVs rather than CVs
+# call the methods as subs with & (this sets a flag in the entersub's op_private)
+# XXX: these are passed in as GVs rather than CVs, which the optimization doesn't currently support
sub test6 {
my $self = shift;
is(&foo($self, 'foo6'), 'foo6');
@@ -118,7 +118,7 @@
if ($warning =~ m{^cxah: (.+)\n$}) {
push @WARNINGS, $1;
} else {
- warn @_; # from perldoc -f warn: __WARN__ hooks are not called from inside one.
+ warn @_; # from perldoc -f warn: "__WARN__ hooks are not called from inside one"
}
};
More information about the Pkg-perl-cvs-commits
mailing list