r65526 - in /trunk/libclass-xsaccessor-perl: ./ XS/ debian/ lib/Class/ lib/Class/XSAccessor/ t/
ansgar at users.alioth.debian.org
ansgar at users.alioth.debian.org
Sat Dec 4 12:32:40 UTC 2010
Author: ansgar
Date: Sat Dec 4 12:32:32 2010
New Revision: 65526
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=65526
Log:
New upstream release.
Added:
trunk/libclass-xsaccessor-perl/XS/HashCACompat.xs
- copied unchanged from r65525, branches/upstream/libclass-xsaccessor-perl/current/XS/HashCACompat.xs
Modified:
trunk/libclass-xsaccessor-perl/Changes
trunk/libclass-xsaccessor-perl/MANIFEST
trunk/libclass-xsaccessor-perl/META.yml
trunk/libclass-xsaccessor-perl/README
trunk/libclass-xsaccessor-perl/XS/Array.xs
trunk/libclass-xsaccessor-perl/XS/Hash.xs
trunk/libclass-xsaccessor-perl/XSAccessor.xs
trunk/libclass-xsaccessor-perl/debian/changelog
trunk/libclass-xsaccessor-perl/debian/copyright
trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor.pm
trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor/Array.pm
trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor/Heavy.pm
trunk/libclass-xsaccessor-perl/t/10hash_lvalue.t
Modified: trunk/libclass-xsaccessor-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/Changes?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/Changes (original)
+++ trunk/libclass-xsaccessor-perl/Changes Sat Dec 4 12:32:32 2010
@@ -1,9 +1,20 @@
Revision history for Perl extension Class-XSAccessor.
+
+1.11 Fri Dec 3 18:00 2010
+ - Fix assignment to lvalue accessors that
+ point at an uninitialized hash element.
+
+1.10 Wed Dec 1 20:44 2010
+ - Fix RT #63458 and potentially #50454
+ We don't occasionally crash during END any more.
+ Instead, we rely on the OS to reap a bit of memory after
+ perl was shut down anyway.
+ - Tiny refactoring for smaller object size.
1.09 Sun Oct 31 12:45 2010
- Fix #62531: Predicates return value, not bool (SJOHNSTON)
- TODO test for perl-crashing bug (in perl) that can happen
- on (arcane) XSUB aliasing on perl's < 5.8.9 (Peter Rabbitson)
+ on (arcane) XSUB aliasing on perls < 5.8.9 (Peter Rabbitson)
We're open for work-around patches.
1.08 Fri Sep 17 20:30 2010
Modified: trunk/libclass-xsaccessor-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/MANIFEST?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/MANIFEST (original)
+++ trunk/libclass-xsaccessor-perl/MANIFEST Sat Dec 4 12:32:32 2010
@@ -38,5 +38,6 @@
t/80threadbomb.t
XS/Array.xs
XS/Hash.xs
+XS/HashCACompat.xs
XSAccessor.xs
META.yml Module meta-data (added by MakeMaker)
Modified: trunk/libclass-xsaccessor-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/META.yml?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/META.yml (original)
+++ trunk/libclass-xsaccessor-perl/META.yml Sat Dec 4 12:32:32 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Class-XSAccessor
-version: 1.09
+version: 1.11
abstract: Generate fast XS accessors without runtime compilation
author:
- Steffen Mueller <smueller at cpan.org>
Modified: trunk/libclass-xsaccessor-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/README?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/README (original)
+++ trunk/libclass-xsaccessor-perl/README Sat Dec 4 12:32:32 2010
@@ -22,7 +22,10 @@
predicates => {
has_foo => 'foo',
has_bar => 'bar',
- }
+ },
+ lvalue_accessors => { # see below
+ baz => 'baz', # ...
+ },
true => [ 'is_token', 'is_whitespace' ],
false => [ 'significant' ];
@@ -34,11 +37,11 @@
package MyClass;
- # Options can be passed as a HASH reference if you prefer it,
- # which can also help PerlTidy to flow the statement correctly.
+ # Options can be passed as a HASH reference, if preferred,
+ # which can also help Perl::Tidy to format the statement correctly.
use Class::XSAccessor {
# If the name => key values are always identical,
- # you can use the following shorthand.
+ # the following shorthand can be used.
accessors => [ 'foo', 'bar' ],
};
@@ -51,7 +54,7 @@
use arrays for their internal representation.
Since version 0.10, the module can also generate simple constructors
- (implemented in XS) for you. Simply supply the "constructor =>
+ (implemented in XS). Simply supply the "constructor =>
'constructor_name'" option or the "constructors => ['new', 'create',
'spawn']" option. These constructors do the equivalent of the following
Perl code:
@@ -64,31 +67,32 @@
That means they can be called on objects and classes but will not clone
objects entirely. Parameters to "new()" are added to the object.
- The XS accessor methods are between 2.6 and 3.4 times faster than
- typical pure-perl accessors in some simple benchmarking. The lower
- factor applies to the potentially slightly obscure "sub set_foo_pp
+ The XS accessor methods are between 3 and 4 times faster than typical
+ pure-Perl accessors in some simple benchmarking. The lower factor
+ applies to the potentially slightly obscure "sub set_foo_pp
{$_[0]->{foo} = $_[1]}", so if you usually write clear code, a factor of
- two speed-up is a good estimate.
+ 3.5 speed-up is a good estimate. If in doubt, do your own benchmarking!
- The method names may be fully qualified. In the example of the synopsis,
- you could have written "MyClass::get_foo" instead of "get_foo". This
- way, you can install methods in classes other than the current class.
- See also: The "class" option below.
+ The method names may be fully qualified. The example in the synopsis
+ could have been written as "MyClass::get_foo" instead of "get_foo". This
+ way, methods can be installed in classes other than the current class.
+ See also: the "class" option below.
- By default, the setters return the new value that was set and the
- accessors (mutators) do the same. You can change this behaviour with the
- "chained" option, see below. The predicates obviously return a boolean.
+ By default, the setters return the new value that was set, and the
+ accessors (mutators) do the same. This behaviour can be changed with the
+ "chained" option - see below. The predicates return a boolean.
- Since version 1.01, you can generate extremely simple methods which just
- return true or false (and always do so). If that seems like a really
- superfluous thing to you, then consider a large class hierarchy with
- interfaces such as PPI. This is implemented as the "true" and "false"
- options, see synopsis.
+ Since version 1.01, "Class::XSAccessor" can generate extremely simple
+ methods which just return true or false (and always do so). If that
+ seems like a really superfluous thing to you, then consider a large
+ class hierarchy with interfaces such as PPI. These methods are provided
+ by the "true" and "false" options - see the synopsis.
OPTIONS
- In addition to specifying the types and names of accessors, you can add
- options which modify behaviour. The options are specified as key/value
- pairs just as the accessor declaration. Example:
+ In addition to specifying the types and names of accessors, additional
+ options can be supplied which modify behaviour. The options are
+ specified as key/value pairs in the same manner as the accessor
+ declaration. For example:
use Class::XSAccessor
getters => {
@@ -112,12 +116,30 @@
the same "use Class::XSAccessor ..." statement.
class
- By default, the accessors are generated in the calling class. Using the
- "class" option, you can explicitly specify where the methods are to be
- generated.
+ By default, the accessors are generated in the calling class. The the
+ "class" option allows the target class to be specified.
+
+LVALUES
+ Support for lvalue accessors via the keyword "lvalue_accessors" was
+ added in version 1.08. At this point, THEY ARE CONSIDERED HIGHLY
+ EXPERIMENTAL. Furthermore, their performance hasn't been benchmarked
+ yet.
+
+ The following example demonstrates an lvalue accessor:
+
+ package Address;
+ use Class::XSAccessor
+ constructor => 'new',
+ lvalue_accessors => { zip_code => 'zip' };
+
+ package main;
+ my $address = Address->new(zip => 2);
+ print $address->zip_code, "\n"; # prints 2
+ $address->zip_code = 76135; # <--- This is it!
+ print $address->zip_code, "\n"; # prints 76135
CAVEATS
- Probably wouldn't work if your objects are *tied* hashes. But that's a
+ Probably won't work for objects based on *tied* hashes. But that's a
strange thing to do anyway.
Scary code exploiting strange XS features.
@@ -127,21 +149,21 @@
accessor for a new hash key that's only known at run-time. Note that
compiling C code at run-time a la Inline::C is a no go.
- Threading. With version 1.00, a memory leak has been fixed that would
- leak a small amount of memory if you loaded "Class::XSAccessor"-based
- classes in a subthread that hadn't been loaded in the "main" thread
- before. If the subthread then terminated, a hash key and an int per
- associated method used ot be lost. Note that this mattered only if
+ Threading. With version 1.00, a memory leak has been fixed. Previously,
+ a small amount of memory would leak if "Class::XSAccessor"-based classes
+ were loaded in a subthread without having been loaded in the "main"
+ thread. If the subthread then terminated, a hash key and an int per
+ associated method used to be lost. Note that this mattered only if
classes were only loaded in a sort of throw-away thread.
- In the new implementation as of 1.00, the memory will not be released
- again either in the above situation. But it will be recycled when the
- same class or a similar class is loaded again in any thread.
+ In the new implementation, as of 1.00, the memory will still not be
+ released, in the same situation, but it will be recycled when the same
+ class, or a similar class, is loaded again in any thread.
SEE ALSO
- Class::XSAccessor::Array
+ * Class::XSAccessor::Array
- AutoXS
+ * AutoXS
AUTHOR
Steffen Mueller <smueller at cpan.org>
Modified: trunk/libclass-xsaccessor-perl/XS/Array.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/XS/Array.xs?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/XS/Array.xs (original)
+++ trunk/libclass-xsaccessor-perl/XS/Array.xs Sat Dec 4 12:32:32 2010
@@ -335,48 +335,52 @@
void
newxs_getter(name, index)
- char* name;
- U32 index;
- PPCODE:
- INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(getter_init), index);
-
-void
-newxs_lvalue_accessor(name, index)
- char* name;
- U32 index;
- PPCODE:
- INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(getter_init), index);
- /* Make the CV lvalue-able. "cv" was set by the previous macro */
- CvLVALUE_on(cv);
+ char* name;
+ U32 index;
+ ALIAS:
+ Class::XSAccessor::Array::newxs_lvalue_accessor = 1
+ Class::XSAccessor::Array::newxs_predicate = 2
+ PPCODE:
+ switch (ix) {
+ case 0: /* newxs_getter */
+ INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(getter_init), index);
+ break;
+ case 1: /* newxs_lvalue_accessor */
+ {
+ CV* cv;
+ INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(getter_init), index);
+ /* Make the CV lvalue-able. "cv" was set by the previous macro */
+ CvLVALUE_on(cv);
+ break;
+ }
+ case 2: /* newxs_predicate */
+ INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(predicate_init), index);
+ break;
+ default:
+ croak("Invalid alias of newxs_getter called");
+ break;
+ }
void
newxs_setter(name, index, chained)
- char* name;
- U32 index;
- bool chained;
- PPCODE:
- if (chained)
- INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(chained_setter_init), index);
- else
- INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(setter_init), index);
-
-void
-newxs_accessor(name, index, chained)
- char* name;
- U32 index;
- bool chained;
- PPCODE:
- if (chained)
- INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(chained_accessor_init), index);
- else
- INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(accessor_init), index);
-
-void
-newxs_predicate(name, index)
- char* name;
- U32 index;
- PPCODE:
- INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(predicate_init), index);
+ char* name;
+ U32 index;
+ bool chained;
+ ALIAS:
+ Class::XSAccessor::Array::newxs_accessor = 1
+ PPCODE:
+ if (ix == 0) { /* newxs_setter */
+ if (chained)
+ INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(chained_setter_init), index);
+ else
+ INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(setter_init), index);
+ }
+ else { /* newxs_accessor */
+ if (chained)
+ INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(chained_accessor_init), index);
+ else
+ INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(accessor_init), index);
+ }
void
newxs_constructor(name)
Modified: trunk/libclass-xsaccessor-perl/XS/Hash.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/XS/Hash.xs?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/XS/Hash.xs (original)
+++ trunk/libclass-xsaccessor-perl/XS/Hash.xs Sat Dec 4 12:32:32 2010
@@ -3,9 +3,12 @@
## we want hv_fetch but with the U32 hash argument of hv_fetch_ent, so do it ourselves...
#ifdef hv_common_key_len
#define CXSA_HASH_FETCH(hv, key, len, hash) hv_common_key_len((hv), (key), (len), HV_FETCH_JUST_SV, NULL, (hash))
+#define CXSA_HASH_FETCH_LVALUE(hv, key, len, hash) hv_common_key_len((hv), (key), (len), (HV_FETCH_JUST_SV|HV_FETCH_LVALUE), NULL, (hash))
#else
-#define CXSA_HASH_FETCH(hv, key, len, hash) hv_fetch(hv, key, len, 0)
+#define CXSA_HASH_FETCH(hv, key, len, hash) hv_fetch((hv), (key), (len), 0)
+#define CXSA_HASH_FETCH_LVALUE(hv, key, len, hash) hv_fetch((hv), (key), (len), 1)
#endif
+
#ifndef croak_xs_usage
#define croak_xs_usage(cv,msg) croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), msg)
@@ -64,7 +67,7 @@
PPCODE:
CXA_CHECK_HASH(self);
CXAH_OPTIMIZE_ENTERSUB(lvalue_accessor);
- if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom.key, readfrom.len, readfrom.hash))) {
+ if ((svp = CXSA_HASH_FETCH_LVALUE((HV *)SvRV(self), readfrom.key, readfrom.len, readfrom.hash))) {
sv = *svp;
sv_upgrade(sv, SVt_PVLV);
sv_magic(sv, 0, PERL_MAGIC_ext, Nullch, 0);
@@ -91,7 +94,7 @@
SV* sv;
PPCODE:
CXA_CHECK_HASH(self);
- if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom.key, readfrom.len, readfrom.hash))) {
+ if ((svp = CXSA_HASH_FETCH_LVALUE((HV *)SvRV(self), readfrom.key, readfrom.len, readfrom.hash))) {
sv = *svp;
sv_upgrade(sv, SVt_PVLV);
sv_magic(sv, 0, PERL_MAGIC_ext, Nullch, 0);
@@ -140,93 +143,6 @@
PUSHs(newvalue);
void
-array_setter_init(self, ...)
- SV* self;
- ALIAS:
- INIT:
- /* NOTE: This method is for Class::Accessor compatibility only. It's not
- * part of the normal API! */
- /* Get the const hash key struct from the global storage */
- /* ix is the magic integer variable that is set by the perl guts for us.
- * We uses it to identify the currently running alias of the accessor. Gollum! */
- SV* newvalue = NULL; /* squelch may-be-used-uninitialized warning that doesn't apply */
- SV ** hashAssignRes;
- const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
- PPCODE:
- CXA_CHECK_HASH(self);
- CXAH_OPTIMIZE_ENTERSUB(array_setter);
- if (items == 2) {
- newvalue = newSVsv(ST(1));
- }
- else if (items > 2) {
- I32 i;
- AV* tmp = newAV();
- av_extend(tmp, items-1);
- for (i = 1; i < items; ++i) {
- newvalue = newSVsv(ST(i));
- if (!av_store(tmp, i-1, newvalue)) {
- SvREFCNT_dec(newvalue);
- croak("Failure to store value in array");
- }
- }
- newvalue = newRV_noinc((SV*) tmp);
- }
- else {
- croak_xs_usage(cv, "self, newvalue(s)");
- }
-
- if ((hashAssignRes = hv_store((HV*)SvRV(self), readfrom.key, readfrom.len, newvalue, readfrom.hash))) {
- PUSHs(*hashAssignRes);
- }
- else {
- SvREFCNT_dec(newvalue);
- croak("Failed to write new value to hash.");
- }
-
-void
-array_setter(self, ...)
- SV* self;
- ALIAS:
- INIT:
- /* NOTE: This method is for Class::Accessor compatibility only. It's not
- * part of the normal API! */
- /* Get the const hash key struct from the global storage */
- /* ix is the magic integer variable that is set by the perl guts for us.
- * We uses it to identify the currently running alias of the accessor. Gollum! */
- SV* newvalue = NULL; /* squelch may-be-used-uninitialized warning that doesn't apply */
- SV ** hashAssignRes;
- const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
- PPCODE:
- CXA_CHECK_HASH(self);
- if (items == 2) {
- newvalue = newSVsv(ST(1));
- }
- else if (items > 2) {
- I32 i;
- AV* tmp = newAV();
- av_extend(tmp, items-1);
- for (i = 1; i < items; ++i) {
- newvalue = newSVsv(ST(i));
- if (!av_store(tmp, i-1, newvalue)) {
- SvREFCNT_dec(newvalue);
- croak("Failure to store value in array");
- }
- }
- newvalue = newRV_noinc((SV*) tmp);
- }
- else {
- croak_xs_usage(cv, "self, newvalue(s)");
- }
-
- if ((hashAssignRes = hv_store((HV*)SvRV(self), readfrom.key, readfrom.len, newvalue, readfrom.hash))) {
- PUSHs(*hashAssignRes);
- }
- else {
- SvREFCNT_dec(newvalue);
- croak("Failed to write new value to hash.");
- }
-
-void
chained_setter_init(self, newvalue)
SV* self;
SV* newvalue;
@@ -310,104 +226,6 @@
XSRETURN_UNDEF;
}
-void
-array_accessor_init(self, ...)
- SV* self;
- ALIAS:
- INIT:
- /* NOTE: This method is for Class::Accessor compatibility only. It's not
- * part of the normal API! */
- /* Get the const hash key struct from the global storage */
- /* ix is the magic integer variable that is set by the perl guts for us.
- * We uses it to identify the currently running alias of the accessor. Gollum! */
- SV ** hashAssignRes;
- const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
- PPCODE:
- CXA_CHECK_HASH(self);
- CXAH_OPTIMIZE_ENTERSUB(array_accessor);
- if (items == 1) {
- SV** svp;
- if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom.key, readfrom.len, readfrom.hash)))
- PUSHs(*svp);
- else
- XSRETURN_UNDEF;
- }
- else { /* writing branch */
- SV* newvalue;
- if (items == 2) {
- newvalue = newSVsv(ST(1));
- }
- else { /* items > 2 */
- I32 i;
- AV* tmp = newAV();
- av_extend(tmp, items-1);
- for (i = 1; i < items; ++i) {
- newvalue = newSVsv(ST(i));
- if (!av_store(tmp, i-1, newvalue)) {
- SvREFCNT_dec(newvalue);
- croak("Failure to store value in array");
- }
- }
- newvalue = newRV_noinc((SV*) tmp);
- }
-
- if ((hashAssignRes = hv_store((HV*)SvRV(self), readfrom.key, readfrom.len, newvalue, readfrom.hash))) {
- PUSHs(*hashAssignRes);
- }
- else {
- SvREFCNT_dec(newvalue);
- croak("Failed to write new value to hash.");
- }
- } /* end writing branch */
-
-void
-array_accessor(self, ...)
- SV* self;
- ALIAS:
- INIT:
- /* NOTE: This method is for Class::Accessor compatibility only. It's not
- * part of the normal API! */
- /* Get the const hash key struct from the global storage */
- /* ix is the magic integer variable that is set by the perl guts for us.
- * We uses it to identify the currently running alias of the accessor. Gollum! */
- SV ** hashAssignRes;
- const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
- PPCODE:
- CXA_CHECK_HASH(self);
- if (items == 1) {
- SV** svp;
- if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom.key, readfrom.len, readfrom.hash)))
- PUSHs(*svp);
- else
- XSRETURN_UNDEF;
- }
- else { /* writing branch */
- SV* newvalue;
- if (items == 2) {
- newvalue = newSVsv(ST(1));
- }
- else { /* items > 2 */
- I32 i;
- AV* tmp = newAV();
- av_extend(tmp, items-1);
- for (i = 1; i < items; ++i) {
- newvalue = newSVsv(ST(i));
- if (!av_store(tmp, i-1, newvalue)) {
- SvREFCNT_dec(newvalue);
- croak("Failure to store value in array");
- }
- }
- newvalue = newRV_noinc((SV*) tmp);
- }
-
- if ((hashAssignRes = hv_store((HV*)SvRV(self), readfrom.key, readfrom.len, newvalue, readfrom.hash))) {
- PUSHs(*hashAssignRes);
- }
- else {
- SvREFCNT_dec(newvalue);
- croak("Failed to write new value to hash.");
- }
- } /* end writing branch */
void
chained_accessor_init(self, ...)
@@ -646,48 +464,49 @@
newxs_getter(name, key)
char* name;
char* key;
- PPCODE:
- INSTALL_NEW_CV_HASH_OBJ(name, CXAH(getter_init), key);
-
-void
-newxs_lvalue_accessor(name, key)
+ ALIAS:
+ Class::XSAccessor::newxs_lvalue_accessor = 1
+ Class::XSAccessor::newxs_predicate = 2
+ PPCODE:
+ switch (ix) {
+ case 0: /* newxs_getter */
+ INSTALL_NEW_CV_HASH_OBJ(name, CXAH(getter_init), key);
+ break;
+ case 1: { /* newxs_lvalue_accessor */
+ CV* cv;
+ INSTALL_NEW_CV_HASH_OBJ(name, CXAH(lvalue_accessor_init), key);
+ /* Make the CV lvalue-able. "cv" was set by the previous macro */
+ CvLVALUE_on(cv);
+ }
+ break;
+ case 2:
+ INSTALL_NEW_CV_HASH_OBJ(name, CXAH(predicate_init), key);
+ break;
+ default:
+ croak("Invalid alias of newxs_getter called");
+ break;
+ }
+
+void
+newxs_setter(name, key, chained)
char* name;
char* key;
- INIT:
- CV *cv;
- PPCODE:
- INSTALL_NEW_CV_HASH_OBJ(name, CXAH(lvalue_accessor_init), key);
- /* Make the CV lvalue-able. "cv" was set by the previous macro */
- CvLVALUE_on(cv);
-
-void
-newxs_setter(name, key, chained)
- char* name;
- char* key;
- bool chained;
- PPCODE:
+ bool chained;
+ ALIAS:
+ Class::XSAccessor::newxs_accessor = 1
+ PPCODE:
+ if (ix == 0) { /* newxs_setter */
if (chained)
INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_setter_init), key);
else
INSTALL_NEW_CV_HASH_OBJ(name, CXAH(setter_init), key);
-
-void
-newxs_accessor(name, key, chained)
- char* name;
- char* key;
- bool chained;
- PPCODE:
- if (chained)
- INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_accessor_init), key);
- else
- INSTALL_NEW_CV_HASH_OBJ(name, CXAH(accessor_init), key);
-
-void
-newxs_predicate(name, key)
- char* name;
- char* key;
- PPCODE:
- INSTALL_NEW_CV_HASH_OBJ(name, CXAH(predicate_init), key);
+ }
+ else { /* newxs_accessor */
+ if (chained)
+ INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_accessor_init), key);
+ else
+ INSTALL_NEW_CV_HASH_OBJ(name, CXAH(accessor_init), key);
+ }
void
newxs_constructor(name)
@@ -713,19 +532,3 @@
INSTALL_NEW_CV_HASH_OBJ(name, CXAH(test_init), key);
-void
-_newxs_compat_setter(name, key)
- char* name;
- char* key;
- PPCODE:
- /* WARNING: If this is called in your code, you're doing it WRONG! */
- INSTALL_NEW_CV_HASH_OBJ(name, CXAH(array_setter_init), key);
-
-void
-_newxs_compat_accessor(name, key)
- char* name;
- char* key;
- PPCODE:
- /* WARNING: If this is called in your code, you're doing it WRONG! */
- INSTALL_NEW_CV_HASH_OBJ(name, CXAH(array_accessor_init), key);
-
Modified: trunk/libclass-xsaccessor-perl/XSAccessor.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/XSAccessor.xs?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/XSAccessor.xs (original)
+++ trunk/libclass-xsaccessor-perl/XSAccessor.xs Sat Dec 4 12:32:32 2010
@@ -563,7 +563,7 @@
PROTOTYPE:
CODE:
if (CXSAccessor_reverse_hashkeys) {
- CXSA_HashTable_free(CXSAccessor_reverse_hashkeys);
+ /*CXSA_HashTable_free(CXSAccessor_reverse_hashkeys);*/
}
void
@@ -578,4 +578,6 @@
INCLUDE: XS/Hash.xs
+INCLUDE: XS/HashCACompat.xs
+
INCLUDE: XS/Array.xs
Modified: trunk/libclass-xsaccessor-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/debian/changelog?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/debian/changelog (original)
+++ trunk/libclass-xsaccessor-perl/debian/changelog Sat Dec 4 12:32:32 2010
@@ -1,3 +1,9 @@
+libclass-xsaccessor-perl (1.11-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Ansgar Burchardt <ansgar at debian.org> Sat, 04 Dec 2010 13:30:16 +0100
+
libclass-xsaccessor-perl (1.09-1) unstable; urgency=low
[ Ansgar Burchardt ]
Modified: trunk/libclass-xsaccessor-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/debian/copyright?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/debian/copyright (original)
+++ trunk/libclass-xsaccessor-perl/debian/copyright Sat Dec 4 12:32:32 2010
@@ -36,5 +36,5 @@
the Free Software Foundation; either version 1, or (at your option)
any later version.
.
- On Debian systems, the complete text of version 1 of the
- General Public License can be found in `/usr/share/common-licenses/GPL-1'.
+ On Debian systems, the complete text of version 1 of the GNU General
+ Public License can be found in `/usr/share/common-licenses/GPL-1'.
Modified: trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor.pm?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor.pm (original)
+++ trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor.pm Sat Dec 4 12:32:32 2010
@@ -6,7 +6,7 @@
use Class::XSAccessor::Heavy;
use XSLoader;
-our $VERSION = '1.09';
+our $VERSION = '1.11';
XSLoader::load('Class::XSAccessor', $VERSION);
Modified: trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor/Array.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor/Array.pm?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor/Array.pm (original)
+++ trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor/Array.pm Sat Dec 4 12:32:32 2010
@@ -6,7 +6,7 @@
use Class::XSAccessor;
use Class::XSAccessor::Heavy;
-our $VERSION = '1.09';
+our $VERSION = '1.11';
sub import {
my $own_class = shift;
Modified: trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor/Heavy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor/Heavy.pm?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor/Heavy.pm (original)
+++ trunk/libclass-xsaccessor-perl/lib/Class/XSAccessor/Heavy.pm Sat Dec 4 12:32:32 2010
@@ -6,7 +6,7 @@
use warnings;
use Carp;
-our $VERSION = '1.09';
+our $VERSION = '1.11';
our @CARP_NOT = qw(
Class::XSAccessor
Class::XSAccessor::Array
Modified: trunk/libclass-xsaccessor-perl/t/10hash_lvalue.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-xsaccessor-perl/t/10hash_lvalue.t?rev=65526&op=diff
==============================================================================
--- trunk/libclass-xsaccessor-perl/t/10hash_lvalue.t (original)
+++ trunk/libclass-xsaccessor-perl/t/10hash_lvalue.t Sat Dec 4 12:32:32 2010
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 11;
BEGIN { use_ok('Class::XSAccessor') };
package Foo;
@@ -23,3 +23,26 @@
ok($x eq 'b');
ok($foo->bar() eq 'buz');
+{ # SCOPE
+ my $baz = bless {} => 'Foo';
+ eval {
+ $baz->bar = 12;
+ };
+ ok(!$@, 'assignment to !exists hash element is okay');
+ is($baz->bar, 12);
+}
+
+{ # SCOPE
+ my $baz = bless {} => 'Foo';
+ my $baz2 = bless {} => 'Foo';
+ eval {
+ $baz->bar = $baz2;
+ };
+ ok(!$@, 'assignment to !exists hash element is okay');
+ eval {
+ $baz->bar->bar = 12;
+ };
+ ok(!$@, 'assignment to !exists hash element is okay');
+ is($baz->bar->bar, 12);
+}
+
More information about the Pkg-perl-cvs-commits
mailing list