r57705 - in /trunk/libautovivification-perl: ./ debian/ lib/ t/ t/lib/autovivification/ t/lib/autovivification/TestRequired4/ t/lib/autovivification/TestRequired5/
ivan at users.alioth.debian.org
ivan at users.alioth.debian.org
Sun May 9 00:32:09 UTC 2010
Author: ivan
Date: Sun May 9 00:32:02 2010
New Revision: 57705
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=57705
Log:
new upstream 0.06
Added:
trunk/libautovivification-perl/t/23-hash-tied.t
- copied unchanged from r57704, branches/upstream/libautovivification-perl/current/t/23-hash-tied.t
trunk/libautovivification-perl/t/33-array-tied.t
- copied unchanged from r57704, branches/upstream/libautovivification-perl/current/t/33-array-tied.t
trunk/libautovivification-perl/t/51-threads-teardown.t
- copied unchanged from r57704, branches/upstream/libautovivification-perl/current/t/51-threads-teardown.t
trunk/libautovivification-perl/t/lib/autovivification/TestRequired4/
- copied from r57704, branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/
trunk/libautovivification-perl/t/lib/autovivification/TestRequired5/
- copied from r57704, branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/
trunk/libautovivification-perl/t/lib/autovivification/TestRequired6.pm
- copied unchanged from r57704, branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired6.pm
Modified:
trunk/libautovivification-perl/Changes
trunk/libautovivification-perl/MANIFEST
trunk/libautovivification-perl/META.yml
trunk/libautovivification-perl/Makefile.PL
trunk/libautovivification-perl/README
trunk/libautovivification-perl/autovivification.xs
trunk/libautovivification-perl/debian/changelog
trunk/libautovivification-perl/debian/control
trunk/libautovivification-perl/lib/autovivification.pm
trunk/libautovivification-perl/t/40-scope.t
Modified: trunk/libautovivification-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libautovivification-perl/Changes?rev=57705&op=diff
==============================================================================
--- trunk/libautovivification-perl/Changes (original)
+++ trunk/libautovivification-perl/Changes Sun May 9 00:32:02 2010
@@ -1,4 +1,12 @@
Revision history for autovivification
+
+0.06 2010-04-24 17:40 UTC
+ + Add : The A_THREADSAFE and A_FORKSAFE constants.
+ + Fix : [RT #56870] : "no autovivification" vs Regexp::Common.
+ This was a bug in how tied arrays and hashes were handled.
+ Thanks Michael G. Schwern for reporting.
+ + Fix : Scope leaks under perl 5.8-5.10.0.
+ + Fix : Segfaults when first loading the pragma from inside a thread.
0.05 2010-03-05 23:15 UTC
+ Fix : [RT #55154] : Crashes and assertion failures when deparsing and
Modified: trunk/libautovivification-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libautovivification-perl/MANIFEST?rev=57705&op=diff
==============================================================================
--- trunk/libautovivification-perl/MANIFEST (original)
+++ trunk/libautovivification-perl/MANIFEST Sun May 9 00:32:02 2010
@@ -10,12 +10,15 @@
t/00-load.t
t/20-hash.t
t/22-hash-kv.t
+t/23-hash-tied.t
t/30-array.t
t/31-array-fast.t
t/32-array-kv.t
+t/33-array-tied.t
t/40-scope.t
t/41-padsv.t
t/42-deparse.t
+t/51-threads-teardown.t
t/91-pod.t
t/92-pod-coverage.t
t/95-portability-files.t
@@ -23,3 +26,11 @@
t/lib/autovivification/TestCases.pm
t/lib/autovivification/TestRequired1.pm
t/lib/autovivification/TestRequired2.pm
+t/lib/autovivification/TestRequired4/a0.pm
+t/lib/autovivification/TestRequired4/b0.pm
+t/lib/autovivification/TestRequired4/c0.pm
+t/lib/autovivification/TestRequired5/a0.pm
+t/lib/autovivification/TestRequired5/b0.pm
+t/lib/autovivification/TestRequired5/c0.pm
+t/lib/autovivification/TestRequired5/d0.pm
+t/lib/autovivification/TestRequired6.pm
Modified: trunk/libautovivification-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libautovivification-perl/META.yml?rev=57705&op=diff
==============================================================================
--- trunk/libautovivification-perl/META.yml (original)
+++ trunk/libautovivification-perl/META.yml Sun May 9 00:32:02 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: autovivification
-version: 0.05
+version: 0.06
abstract: Lexically disable autovivification.
author:
- Vincent Pit <perl at profvince.com>
@@ -28,4 +28,4 @@
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
-dynamic_config: 0
+dynamic_config: 1
Modified: trunk/libautovivification-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libautovivification-perl/Makefile.PL?rev=57705&op=diff
==============================================================================
--- trunk/libautovivification-perl/Makefile.PL (original)
+++ trunk/libautovivification-perl/Makefile.PL Sun May 9 00:32:02 2010
@@ -3,6 +3,20 @@
use strict;
use warnings;
use ExtUtils::MakeMaker;
+
+my @DEFINES;
+
+# Threads, Windows and 5.8.x don't seem to be best friends
+if ($^O eq 'MSWin32' && $^V lt v5.9.0) {
+ push @DEFINES, '-DA_MULTIPLICITY=0';
+}
+
+# Fork emulation got "fixed" in 5.10.1
+if ($^O eq 'MSWin32' && $^V lt v5.10.1) {
+ push @DEFINES, '-DA_FORKSAFE=0';
+}
+
+ at DEFINES = (DEFINE => join ' ', @DEFINES) if @DEFINES;
my $dist = 'autovivification';
@@ -24,7 +38,7 @@
'Test::More' => 0,
%PREREQ_PM,
},
- dynamic_config => 0,
+ dynamic_config => 1,
resources => {
bugtracker => "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$dist",
homepage => "http://search.cpan.org/dist/$dist/",
@@ -40,6 +54,7 @@
VERSION_FROM => $file,
ABSTRACT_FROM => $file,
PL_FILES => {},
+ @DEFINES,
PREREQ_PM => \%PREREQ_PM,
MIN_PERL_VERSION => 5.008,
META_MERGE => \%META,
Modified: trunk/libautovivification-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libautovivification-perl/README?rev=57705&op=diff
==============================================================================
--- trunk/libautovivification-perl/README (original)
+++ trunk/libautovivification-perl/README Sun May 9 00:32:02 2010
@@ -2,7 +2,7 @@
autovivification - Lexically disable autovivification.
VERSION
- Version 0.05
+ Version 0.06
SYNOPSIS
no autovivification;
@@ -93,6 +93,17 @@
When @opts is empty, it defaults to restoring the original Perl
autovivification behaviour.
+CONSTANTS
+ "A_THREADSAFE"
+ True iff the module could have been built with thread-safety features
+ enabled. This constant only has a meaning with your perl is threaded ;
+ otherwise, it'll always be false.
+
+ "A_FORKSAFE"
+ True iff this module could have been built with fork-safety features
+ enabled. This will always be true except on Windows where it's false for
+ perl 5.10.0 and below .
+
CAVEATS
The pragma doesn't apply when one dereferences the returned value of an
array or hash slice, as in "@array[$id]->{member}" or
Modified: trunk/libautovivification-perl/autovivification.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libautovivification-perl/autovivification.xs?rev=57705&op=diff
==============================================================================
--- trunk/libautovivification-perl/autovivification.xs (original)
+++ trunk/libautovivification-perl/autovivification.xs Sun May 9 00:32:02 2010
@@ -11,84 +11,253 @@
/* --- Compatibility wrappers ---------------------------------------------- */
+#ifndef HvNAME_get
+# define HvNAME_get(H) HvNAME(H)
+#endif
+
+#ifndef HvNAMELEN_get
+# define HvNAMELEN_get(H) strlen(HvNAME_get(H))
+#endif
+
#define A_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
+
+#undef ENTERn
+#if defined(ENTER_with_name) && !A_HAS_PERL(5, 11, 4)
+# define ENTERn(N) ENTER_with_name(N)
+#else
+# define ENTERn(N) ENTER
+#endif
+
+#undef LEAVEn
+#if defined(LEAVE_with_name) && !A_HAS_PERL(5, 11, 4)
+# define LEAVEn(N) LEAVE_with_name(N)
+#else
+# define LEAVEn(N) LEAVE
+#endif
#ifndef A_WORKAROUND_REQUIRE_PROPAGATION
# define A_WORKAROUND_REQUIRE_PROPAGATION !A_HAS_PERL(5, 10, 1)
#endif
+/* ... Thread safety and multiplicity ...................................... */
+
+/* Always safe when the workaround isn't needed */
+#if !A_WORKAROUND_REQUIRE_PROPAGATION
+# undef A_FORKSAFE
+# define A_FORKSAFE 1
+/* Otherwise, safe unless Makefile.PL says it's Win32 */
+#elif !defined(A_FORKSAFE)
+# define A_FORKSAFE 1
+#endif
+
+#ifndef A_MULTIPLICITY
+# if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT)
+# define A_MULTIPLICITY 1
+# else
+# define A_MULTIPLICITY 0
+# endif
+#endif
+#if A_MULTIPLICITY && !defined(tTHX)
+# define tTHX PerlInterpreter*
+#endif
+
+#if A_MULTIPLICITY && defined(USE_ITHREADS) && defined(dMY_CXT) && defined(MY_CXT) && defined(START_MY_CXT) && defined(MY_CXT_INIT) && (defined(MY_CXT_CLONE) || defined(dMY_CXT_SV))
+# define A_THREADSAFE 1
+# ifndef MY_CXT_CLONE
+# define MY_CXT_CLONE \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \
+ Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+# endif
+#else
+# define A_THREADSAFE 0
+# undef dMY_CXT
+# define dMY_CXT dNOOP
+# undef MY_CXT
+# define MY_CXT a_globaldata
+# undef START_MY_CXT
+# define START_MY_CXT STATIC my_cxt_t MY_CXT;
+# undef MY_CXT_INIT
+# define MY_CXT_INIT NOOP
+# undef MY_CXT_CLONE
+# define MY_CXT_CLONE NOOP
+#endif
+
/* --- Helpers ------------------------------------------------------------- */
+/* ... Thread-safe hints ................................................... */
+
#if A_WORKAROUND_REQUIRE_PROPAGATION
-#define A_ENCODE_UV(B, U) \
- len = 0; \
- while (len < sizeof(UV)) { \
- (B)[len++] = (U) & 0xFF; \
- (U) >>= 8; \
- }
-
-#define A_DECODE_UV(U, B) \
- len = sizeof(UV); \
- while (len > 0) \
- (U) = ((U) << 8) | (B)[--len];
-
-#if A_WORKAROUND_REQUIRE_PROPAGATION
-STATIC UV a_require_tag(pTHX) {
+typedef struct {
+ U32 bits;
+ IV require_tag;
+} a_hint_t;
+
+#define A_HINT_FREE(H) PerlMemShared_free(H)
+
+#if A_THREADSAFE
+
+#define PTABLE_NAME ptable_hints
+#define PTABLE_VAL_FREE(V) A_HINT_FREE(V)
+
+#define pPTBL pTHX
+#define pPTBL_ pTHX_
+#define aPTBL aTHX
+#define aPTBL_ aTHX_
+
+#include "ptable.h"
+
+#define ptable_hints_store(T, K, V) ptable_hints_store(aTHX_ (T), (K), (V))
+#define ptable_hints_free(T) ptable_hints_free(aTHX_ (T))
+
+#define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION
+
+typedef struct {
+ ptable *tbl; /* It really is a ptable_hints */
+ tTHX owner;
+} my_cxt_t;
+
+START_MY_CXT
+
+STATIC SV *a_clone(pTHX_ SV *sv, tTHX owner) {
+#define a_clone(S, O) a_clone(aTHX_ (S), (O))
+ CLONE_PARAMS param;
+ AV *stashes = NULL;
+ SV *dupsv;
+
+ if (SvTYPE(sv) == SVt_PVHV && HvNAME_get(sv))
+ stashes = newAV();
+
+ param.stashes = stashes;
+ param.flags = 0;
+ param.proto_perl = owner;
+
+ dupsv = sv_dup(sv, ¶m);
+
+ if (stashes) {
+ av_undef(stashes);
+ SvREFCNT_dec(stashes);
+ }
+
+ return SvREFCNT_inc(dupsv);
+}
+
+STATIC void a_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
+ my_cxt_t *ud = ud_;
+ a_hint_t *h1 = ent->val;
+ a_hint_t *h2;
+
+ if (ud->owner == aTHX)
+ return;
+
+ h2 = PerlMemShared_malloc(sizeof *h2);
+ h2->bits = h1->bits;
+ h2->require_tag = PTR2IV(a_clone(INT2PTR(SV *, h1->require_tag), ud->owner));
+
+ ptable_hints_store(ud->tbl, ent->key, h2);
+}
+
+STATIC void a_thread_cleanup(pTHX_ void *);
+
+STATIC void a_thread_cleanup(pTHX_ void *ud) {
+ int *level = ud;
+
+ if (*level) {
+ *level = 0;
+ LEAVE;
+ SAVEDESTRUCTOR_X(a_thread_cleanup, level);
+ ENTER;
+ } else {
+ dMY_CXT;
+ PerlMemShared_free(level);
+ ptable_hints_free(MY_CXT.tbl);
+ }
+}
+
+#endif /* A_THREADSAFE */
+
+STATIC IV a_require_tag(pTHX) {
#define a_require_tag() a_require_tag(aTHX)
- const PERL_SI *si;
-
- for (si = PL_curstackinfo; si; si = si->si_prev) {
- I32 cxix;
-
- for (cxix = si->si_cxix; cxix >= 0; --cxix) {
- const PERL_CONTEXT *cx = si->si_cxstack + cxix;
-
- if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE)
- return PTR2UV(cx);
+ const CV *cv, *outside;
+
+ cv = PL_compcv;
+
+ if (!cv) {
+ /* If for some reason the pragma is operational at run-time, try to discover
+ * the current cv in use. */
+ const PERL_SI *si;
+
+ for (si = PL_curstackinfo; si; si = si->si_prev) {
+ I32 cxix;
+
+ for (cxix = si->si_cxix; cxix >= 0; --cxix) {
+ const PERL_CONTEXT *cx = si->si_cxstack + cxix;
+
+ switch (CxTYPE(cx)) {
+ case CXt_SUB:
+ case CXt_FORMAT:
+ /* The propagation workaround is only needed up to 5.10.0 and at that
+ * time format and sub contexts were still identical. And even later the
+ * cv members offsets should have been kept the same. */
+ cv = cx->blk_sub.cv;
+ goto get_enclosing_cv;
+ case CXt_EVAL:
+ cv = cx->blk_eval.cv;
+ goto get_enclosing_cv;
+ default:
+ break;
+ }
+ }
}
- }
-
- return PTR2UV(NULL);
-}
-#endif /* A_WORKAROUND_REQUIRE_PROPAGATION */
+
+ cv = PL_main_cv;
+ }
+
+get_enclosing_cv:
+ for (outside = CvOUTSIDE(cv); outside; outside = CvOUTSIDE(cv))
+ cv = outside;
+
+ return PTR2IV(cv);
+}
STATIC SV *a_tag(pTHX_ UV bits) {
#define a_tag(B) a_tag(aTHX_ (B))
- SV *hint;
- const PERL_SI *si;
- UV cxreq;
- unsigned char buf[sizeof(UV) * 2];
- STRLEN len;
-
- cxreq = a_require_tag();
- A_ENCODE_UV(buf, cxreq);
- A_ENCODE_UV(buf + sizeof(UV), bits);
- hint = newSVpvn(buf, sizeof buf);
- SvREADONLY_on(hint);
-
- return hint;
+ a_hint_t *h;
+ dMY_CXT;
+
+ h = PerlMemShared_malloc(sizeof *h);
+ h->bits = bits;
+ h->require_tag = a_require_tag();
+
+#if A_THREADSAFE
+ /* We only need for the key to be an unique tag for looking up the value later.
+ * Allocated memory provides convenient unique identifiers, so that's why we
+ * use the hint as the key itself. */
+ ptable_hints_store(MY_CXT.tbl, h, h);
+#endif /* A_THREADSAFE */
+
+ return newSViv(PTR2IV(h));
}
STATIC UV a_detag(pTHX_ const SV *hint) {
#define a_detag(H) a_detag(aTHX_ (H))
- const PERL_SI *si;
- UV cxreq = 0, bits = 0;
- unsigned char *buf;
- STRLEN len;
-
- if (!(hint && SvOK(hint)))
+ a_hint_t *h;
+ dMY_CXT;
+
+ if (!(hint && SvIOK(hint)))
return 0;
- buf = SvPVX(hint);
-
- A_DECODE_UV(cxreq, buf);
- if (a_require_tag() != cxreq)
+ h = INT2PTR(a_hint_t *, SvIVX(hint));
+#if A_THREADSAFE
+ h = ptable_fetch(MY_CXT.tbl, h);
+#endif /* A_THREADSAFE */
+
+ if (a_require_tag() != h->require_tag)
return 0;
- A_DECODE_UV(bits, buf + sizeof(UV));
-
- return bits;
+ return h->bits;
}
#else /* A_WORKAROUND_REQUIRE_PROPAGATION */
@@ -378,7 +547,9 @@
defined = TRUE;
break;
default:
- defined = SvOK(sv);
+ SvGETMAGIC(sv);
+ if (SvOK(sv))
+ defined = TRUE;
}
return defined;
@@ -403,7 +574,7 @@
flags = oi.flags;
if (flags & A_HINT_DEREF) {
- if (!SvOK(TOPs)) {
+ if (!a_defined(TOPs)) {
/* We always need to push an empty array to fool the pp_aelem() that comes
* later. */
SV *av;
@@ -430,7 +601,7 @@
flags = oi.flags;
if (flags & A_HINT_DEREF) {
- if (!SvOK(TOPs))
+ if (!a_defined(TOPs))
RETURN;
} else {
PL_op->op_ppaddr = oi.old_pp;
@@ -448,7 +619,7 @@
flags = oi.flags;
if (flags & A_HINT_DEREF) {
- if (!SvOK(TOPs)) {
+ if (!a_defined(TOPs)) {
SV *hv;
POPs;
hv = sv_2mortal((SV *) newHV());
@@ -484,7 +655,7 @@
if (flags & (A_HINT_NOTIFY|A_HINT_STORE)) {
SPAGAIN;
- if (!SvOK(TOPs)) {
+ if (!a_defined(TOPs)) {
if (flags & A_HINT_STRICT)
croak("Reference vivification forbidden");
else if (flags & A_HINT_WARN)
@@ -802,6 +973,117 @@
STATIC U32 a_initialized = 0;
+STATIC void a_teardown(pTHX_ void *root) {
+
+ if (!a_initialized)
+ return;
+
+#if A_MULTIPLICITY
+ if (aTHX != root)
+ return;
+#endif
+
+#if A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION
+ {
+ dMY_CXT;
+ ptable_hints_free(MY_CXT.tbl);
+ }
+#endif
+
+ PL_check[OP_PADANY] = MEMBER_TO_FPTR(a_old_ck_padany);
+ a_old_ck_padany = 0;
+ PL_check[OP_PADSV] = MEMBER_TO_FPTR(a_old_ck_padsv);
+ a_old_ck_padsv = 0;
+
+ PL_check[OP_AELEM] = MEMBER_TO_FPTR(a_old_ck_aelem);
+ a_old_ck_aelem = 0;
+ PL_check[OP_HELEM] = MEMBER_TO_FPTR(a_old_ck_helem);
+ a_old_ck_helem = 0;
+ PL_check[OP_RV2SV] = MEMBER_TO_FPTR(a_old_ck_rv2sv);
+ a_old_ck_rv2sv = 0;
+
+ PL_check[OP_RV2AV] = MEMBER_TO_FPTR(a_old_ck_rv2av);
+ a_old_ck_rv2av = 0;
+ PL_check[OP_RV2HV] = MEMBER_TO_FPTR(a_old_ck_rv2hv);
+ a_old_ck_rv2hv = 0;
+
+ PL_check[OP_ASLICE] = MEMBER_TO_FPTR(a_old_ck_aslice);
+ a_old_ck_aslice = 0;
+ PL_check[OP_HSLICE] = MEMBER_TO_FPTR(a_old_ck_hslice);
+ a_old_ck_hslice = 0;
+
+ PL_check[OP_EXISTS] = MEMBER_TO_FPTR(a_old_ck_exists);
+ a_old_ck_exists = 0;
+ PL_check[OP_DELETE] = MEMBER_TO_FPTR(a_old_ck_delete);
+ a_old_ck_delete = 0;
+ PL_check[OP_KEYS] = MEMBER_TO_FPTR(a_old_ck_keys);
+ a_old_ck_keys = 0;
+ PL_check[OP_VALUES] = MEMBER_TO_FPTR(a_old_ck_values);
+ a_old_ck_values = 0;
+
+ if (a_pp_padsv_saved) {
+ PL_ppaddr[OP_PADSV] = a_pp_padsv_saved;
+ a_pp_padsv_saved = 0;
+ }
+
+ a_initialized = 0;
+}
+
+STATIC void a_setup(pTHX) {
+#define a_setup() a_setup(aTHX)
+ if (a_initialized)
+ return;
+
+#if A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION
+ {
+ MY_CXT_INIT;
+ MY_CXT.tbl = ptable_new();
+ MY_CXT.owner = aTHX;
+ }
+#endif
+
+ a_old_ck_padany = PL_check[OP_PADANY];
+ PL_check[OP_PADANY] = MEMBER_TO_FPTR(a_ck_padany);
+ a_old_ck_padsv = PL_check[OP_PADSV];
+ PL_check[OP_PADSV] = MEMBER_TO_FPTR(a_ck_padsv);
+
+ a_old_ck_aelem = PL_check[OP_AELEM];
+ PL_check[OP_AELEM] = MEMBER_TO_FPTR(a_ck_deref);
+ a_old_ck_helem = PL_check[OP_HELEM];
+ PL_check[OP_HELEM] = MEMBER_TO_FPTR(a_ck_deref);
+ a_old_ck_rv2sv = PL_check[OP_RV2SV];
+ PL_check[OP_RV2SV] = MEMBER_TO_FPTR(a_ck_deref);
+
+ a_old_ck_rv2av = PL_check[OP_RV2AV];
+ PL_check[OP_RV2AV] = MEMBER_TO_FPTR(a_ck_rv2xv);
+ a_old_ck_rv2hv = PL_check[OP_RV2HV];
+ PL_check[OP_RV2HV] = MEMBER_TO_FPTR(a_ck_rv2xv);
+
+ a_old_ck_aslice = PL_check[OP_ASLICE];
+ PL_check[OP_ASLICE] = MEMBER_TO_FPTR(a_ck_xslice);
+ a_old_ck_hslice = PL_check[OP_HSLICE];
+ PL_check[OP_HSLICE] = MEMBER_TO_FPTR(a_ck_xslice);
+
+ a_old_ck_exists = PL_check[OP_EXISTS];
+ PL_check[OP_EXISTS] = MEMBER_TO_FPTR(a_ck_root);
+ a_old_ck_delete = PL_check[OP_DELETE];
+ PL_check[OP_DELETE] = MEMBER_TO_FPTR(a_ck_root);
+ a_old_ck_keys = PL_check[OP_KEYS];
+ PL_check[OP_KEYS] = MEMBER_TO_FPTR(a_ck_root);
+ a_old_ck_values = PL_check[OP_VALUES];
+ PL_check[OP_VALUES] = MEMBER_TO_FPTR(a_ck_root);
+
+#if A_MULTIPLICITY
+ call_atexit(a_teardown, aTHX);
+#else
+ call_atexit(a_teardown, NULL);
+#endif
+
+ a_initialized = 1;
+}
+
+STATIC U32 a_booted = 0;
+
/* --- XS ------------------------------------------------------------------ */
MODULE = autovivification PACKAGE = autovivification
@@ -810,7 +1092,7 @@
BOOT:
{
- if (!a_initialized++) {
+ if (!a_booted++) {
HV *stash;
a_op_map = ptable_new();
@@ -819,37 +1101,6 @@
#endif
PERL_HASH(a_hash, __PACKAGE__, __PACKAGE_LEN__);
-
- a_old_ck_padany = PL_check[OP_PADANY];
- PL_check[OP_PADANY] = MEMBER_TO_FPTR(a_ck_padany);
- a_old_ck_padsv = PL_check[OP_PADSV];
- PL_check[OP_PADSV] = MEMBER_TO_FPTR(a_ck_padsv);
-
- a_old_ck_aelem = PL_check[OP_AELEM];
- PL_check[OP_AELEM] = MEMBER_TO_FPTR(a_ck_deref);
- a_old_ck_helem = PL_check[OP_HELEM];
- PL_check[OP_HELEM] = MEMBER_TO_FPTR(a_ck_deref);
- a_old_ck_rv2sv = PL_check[OP_RV2SV];
- PL_check[OP_RV2SV] = MEMBER_TO_FPTR(a_ck_deref);
-
- a_old_ck_rv2av = PL_check[OP_RV2AV];
- PL_check[OP_RV2AV] = MEMBER_TO_FPTR(a_ck_rv2xv);
- a_old_ck_rv2hv = PL_check[OP_RV2HV];
- PL_check[OP_RV2HV] = MEMBER_TO_FPTR(a_ck_rv2xv);
-
- a_old_ck_aslice = PL_check[OP_ASLICE];
- PL_check[OP_ASLICE] = MEMBER_TO_FPTR(a_ck_xslice);
- a_old_ck_hslice = PL_check[OP_HSLICE];
- PL_check[OP_HSLICE] = MEMBER_TO_FPTR(a_ck_xslice);
-
- a_old_ck_exists = PL_check[OP_EXISTS];
- PL_check[OP_EXISTS] = MEMBER_TO_FPTR(a_ck_root);
- a_old_ck_delete = PL_check[OP_DELETE];
- PL_check[OP_DELETE] = MEMBER_TO_FPTR(a_ck_root);
- a_old_ck_keys = PL_check[OP_KEYS];
- PL_check[OP_KEYS] = MEMBER_TO_FPTR(a_ck_root);
- a_old_ck_values = PL_check[OP_VALUES];
- PL_check[OP_VALUES] = MEMBER_TO_FPTR(a_ck_root);
stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1);
newCONSTSUB(stash, "A_HINT_STRICT", newSVuv(A_HINT_STRICT));
@@ -859,8 +1110,43 @@
newCONSTSUB(stash, "A_HINT_EXISTS", newSVuv(A_HINT_EXISTS));
newCONSTSUB(stash, "A_HINT_DELETE", newSVuv(A_HINT_DELETE));
newCONSTSUB(stash, "A_HINT_MASK", newSVuv(A_HINT_MASK));
- }
-}
+ newCONSTSUB(stash, "A_THREADSAFE", newSVuv(A_THREADSAFE));
+ newCONSTSUB(stash, "A_FORKSAFE", newSVuv(A_FORKSAFE));
+ }
+
+ a_setup();
+}
+
+#if A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION
+
+void
+CLONE(...)
+PROTOTYPE: DISABLE
+PREINIT:
+ ptable *t;
+ int *level;
+CODE:
+ {
+ my_cxt_t ud;
+ dMY_CXT;
+ ud.tbl = t = ptable_new();
+ ud.owner = MY_CXT.owner;
+ ptable_walk(MY_CXT.tbl, a_ptable_clone, &ud);
+ }
+ {
+ MY_CXT_CLONE;
+ MY_CXT.tbl = t;
+ MY_CXT.owner = aTHX;
+ }
+ {
+ level = PerlMemShared_malloc(sizeof *level);
+ *level = 1;
+ LEAVEn("sub");
+ SAVEDESTRUCTOR_X(a_thread_cleanup, level);
+ ENTERn("sub");
+ }
+
+#endif
SV *
_tag(SV *hint)
Modified: trunk/libautovivification-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libautovivification-perl/debian/changelog?rev=57705&op=diff
==============================================================================
--- trunk/libautovivification-perl/debian/changelog (original)
+++ trunk/libautovivification-perl/debian/changelog Sun May 9 00:32:02 2010
@@ -1,4 +1,4 @@
-libautovivification-perl (0.05-2) UNRELEASED; urgency=low
+libautovivification-perl (0.06-1) UNRELEASED; urgency=low
* Take over for the Debian Perl Group
* debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
@@ -6,8 +6,9 @@
<pkg-perl-maintainers at lists.alioth.debian.org> (was: Ivan Kohler
<ivan-debian at 420.am>); Ivan Kohler <ivan-debian at 420.am> moved to
Uploaders.
+ * New upstream release
- -- Ivan Kohler <ivan-debian at 420.am> Sat, 08 May 2010 17:26:49 -0700
+ -- Ivan Kohler <ivan-debian at 420.am> Sat, 08 May 2010 17:30:08 -0700
libautovivification-perl (0.05-1) unstable; urgency=low
Modified: trunk/libautovivification-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libautovivification-perl/debian/control?rev=57705&op=diff
==============================================================================
--- trunk/libautovivification-perl/debian/control (original)
+++ trunk/libautovivification-perl/debian/control Sun May 9 00:32:02 2010
@@ -12,7 +12,7 @@
Package: libautovivification-perl
Architecture: any
Depends: ${perl:Depends}, ${shlibs:Depends}, ${misc:Depends}, perl (>= 5.8)
-Description: Lexically disable autovivification.
+Description: Perl module to lexically disable autovivification
When an undefined variable is dereferenced, it gets silently upgraded to an
array or hash reference (depending of the type of the dereferencing). This
behaviour is called autovivification and usually does what you mean (e.g.
Modified: trunk/libautovivification-perl/lib/autovivification.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libautovivification-perl/lib/autovivification.pm?rev=57705&op=diff
==============================================================================
--- trunk/libautovivification-perl/lib/autovivification.pm (original)
+++ trunk/libautovivification-perl/lib/autovivification.pm Sun May 9 00:32:02 2010
@@ -11,13 +11,13 @@
=head1 VERSION
-Version 0.05
+Version 0.06
=cut
our $VERSION;
BEGIN {
- $VERSION = '0.05';
+ $VERSION = '0.06';
}
=head1 SYNOPSIS
@@ -151,6 +151,18 @@
();
}
+=head1 CONSTANTS
+
+=head2 C<A_THREADSAFE>
+
+True iff the module could have been built with thread-safety features enabled.
+This constant only has a meaning with your perl is threaded ; otherwise, it'll always be false.
+
+=head2 C<A_FORKSAFE>
+
+True iff this module could have been built with fork-safety features enabled.
+This will always be true except on Windows where it's false for perl 5.10.0 and below .
+
=head1 CAVEATS
The pragma doesn't apply when one dereferences the returned value of an array or hash slice, as in C<< @array[$id]->{member} >> or C<< @hash{$key}->{member} >>.
Modified: trunk/libautovivification-perl/t/40-scope.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libautovivification-perl/t/40-scope.t?rev=57705&op=diff
==============================================================================
--- trunk/libautovivification-perl/t/40-scope.t (original)
+++ trunk/libautovivification-perl/t/40-scope.t Sun May 9 00:32:02 2010
@@ -1,9 +1,9 @@
-#!perl -T
+#!perl
use strict;
use warnings;
-use Test::More tests => 8;
+use Test::More tests => 12;
use lib 't/lib';
@@ -41,3 +41,31 @@
$expect->{r2_eval} = { } if $] < 5.009005;
is_deeply $blurp, $expect, 'second require test didn\'t vivify';
}
+
+# This test may not fail for the old version when ran in taint mode
+{
+ my $err = eval <<' SNIP';
+ use autovivification::TestRequired4::a0;
+ autovivification::TestRequired4::a0::error();
+ SNIP
+ is $err, '', 'RT #50570';
+}
+
+# This test must be in the topmost scope
+BEGIN { eval 'use autovivification::TestRequired5::a0' }
+my $err = autovivification::TestRequired5::a0::error();
+is $err, '', 'identifying requires by their eval context pointer is not enough';
+
+{
+ local $blurp;
+
+ no autovivification;
+ use autovivification::TestRequired6;
+
+ autovivification::TestRequired6::bar();
+ is_deeply $blurp, { }, 'vivified without eval';
+
+ $blurp = undef;
+ autovivification::TestRequired6::baz();
+ is_deeply $blurp, { }, 'vivified with eval';
+}
More information about the Pkg-perl-cvs-commits
mailing list