r57703 - in /branches/upstream/libautovivification-perl/current: ./ 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:29:22 UTC 2010
Author: ivan
Date: Sun May 9 00:29:13 2010
New Revision: 57703
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=57703
Log:
[svn-upgrade] Integrating new upstream version, libautovivification-perl (0.06)
Added:
branches/upstream/libautovivification-perl/current/t/23-hash-tied.t
branches/upstream/libautovivification-perl/current/t/33-array-tied.t
branches/upstream/libautovivification-perl/current/t/51-threads-teardown.t
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/a0.pm
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/b0.pm
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/c0.pm
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/a0.pm
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/b0.pm
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/c0.pm
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/d0.pm
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired6.pm
Modified:
branches/upstream/libautovivification-perl/current/Changes
branches/upstream/libautovivification-perl/current/MANIFEST
branches/upstream/libautovivification-perl/current/META.yml
branches/upstream/libautovivification-perl/current/Makefile.PL
branches/upstream/libautovivification-perl/current/README
branches/upstream/libautovivification-perl/current/autovivification.xs
branches/upstream/libautovivification-perl/current/lib/autovivification.pm
branches/upstream/libautovivification-perl/current/t/40-scope.t
Modified: branches/upstream/libautovivification-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/Changes?rev=57703&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/Changes (original)
+++ branches/upstream/libautovivification-perl/current/Changes Sun May 9 00:29:13 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: branches/upstream/libautovivification-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/MANIFEST?rev=57703&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/MANIFEST (original)
+++ branches/upstream/libautovivification-perl/current/MANIFEST Sun May 9 00:29:13 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: branches/upstream/libautovivification-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/META.yml?rev=57703&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/META.yml (original)
+++ branches/upstream/libautovivification-perl/current/META.yml Sun May 9 00:29:13 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: branches/upstream/libautovivification-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/Makefile.PL?rev=57703&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/Makefile.PL (original)
+++ branches/upstream/libautovivification-perl/current/Makefile.PL Sun May 9 00:29:13 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: branches/upstream/libautovivification-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/README?rev=57703&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/README (original)
+++ branches/upstream/libautovivification-perl/current/README Sun May 9 00:29:13 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: branches/upstream/libautovivification-perl/current/autovivification.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/autovivification.xs?rev=57703&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/autovivification.xs (original)
+++ branches/upstream/libautovivification-perl/current/autovivification.xs Sun May 9 00:29:13 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: branches/upstream/libautovivification-perl/current/lib/autovivification.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/lib/autovivification.pm?rev=57703&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/lib/autovivification.pm (original)
+++ branches/upstream/libautovivification-perl/current/lib/autovivification.pm Sun May 9 00:29:13 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} >>.
Added: branches/upstream/libautovivification-perl/current/t/23-hash-tied.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/23-hash-tied.t?rev=57703&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/23-hash-tied.t (added)
+++ branches/upstream/libautovivification-perl/current/t/23-hash-tied.t Sun May 9 00:29:13 2010
@@ -1,0 +1,27 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ eval 'use Tie::Hash; scalar keys %Tie::StdHash::'
+ or plan skip_all => 'Tie::StdHash required to test tied hashes';
+ defined and diag "Using Tie::StdHash $_" for $Tie::Hash::VERSION;
+ plan tests => 1;
+}
+
+{
+ tie my %x, 'Tie::StdHash';
+ tie my %y, 'Tie::StdHash';
+
+ $x{key} = 'hlagh';
+ $y{x} = \%x;
+
+ my $res = do {
+ no autovivification;
+ $y{x}{key};
+ };
+ is $res, 'hlagh', 'nested tied hashes';
+}
Added: branches/upstream/libautovivification-perl/current/t/33-array-tied.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/33-array-tied.t?rev=57703&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/33-array-tied.t (added)
+++ branches/upstream/libautovivification-perl/current/t/33-array-tied.t Sun May 9 00:29:13 2010
@@ -1,0 +1,27 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ eval 'use Tie::Array; scalar keys %Tie::StdArray::'
+ or plan skip_all => 'Tie::StdArray required to test tied arrays';
+ defined and diag "Using Tie::StdArray $_" for $Tie::Array::VERSION;
+ plan tests => 1;
+}
+
+{
+ tie my @a, 'Tie::StdArray';
+ tie my @b, 'Tie::StdArray';
+
+ $a[1] = 'hlagh';
+ $b[0] = \@a;
+
+ my $res = do {
+ no autovivification;
+ $b[0][1];
+ };
+ is $res, 'hlagh', 'nested tied arrays';
+}
Modified: branches/upstream/libautovivification-perl/current/t/40-scope.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/40-scope.t?rev=57703&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/40-scope.t (original)
+++ branches/upstream/libautovivification-perl/current/t/40-scope.t Sun May 9 00:29:13 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';
+}
Added: branches/upstream/libautovivification-perl/current/t/51-threads-teardown.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/51-threads-teardown.t?rev=57703&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/51-threads-teardown.t (added)
+++ branches/upstream/libautovivification-perl/current/t/51-threads-teardown.t Sun May 9 00:29:13 2010
@@ -1,0 +1,57 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Config qw/%Config/;
+
+BEGIN {
+ if (!$Config{useithreads}) {
+ require Test::More;
+ Test::More->import;
+ plan(skip_all => 'This perl wasn\'t built to support threads');
+ }
+}
+
+use threads;
+
+use Test::More;
+
+BEGIN {
+ require autovivification;
+ if (autovivification::A_THREADSAFE()) {
+ plan tests => 1;
+ defined and diag "Using threads $_" for $threads::VERSION;
+ } else {
+ plan skip_all => 'This autovivification isn\'t thread safe';
+ }
+}
+
+sub run_perl {
+ my $code = shift;
+
+ my $SystemRoot = $ENV{SystemRoot};
+ local %ENV;
+ $ENV{SystemRoot} = $SystemRoot if $^O eq 'MSWin32' and defined $SystemRoot;
+
+ system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code;
+}
+
+SKIP:
+{
+ skip 'Fails on 5.8.2 and lower' => 1 if $] <= 5.008002;
+
+ my $status = run_perl <<' RUN';
+ my $code = 1 + 2 + 4;
+ use threads;
+ $code -= threads->create(sub {
+ eval q{no autovivification; my $x; my $y = $x->{foo}; $x};
+ return defined($x) ? 0 : 1;
+ })->join;
+ $code -= defined(eval q{my $x; my $y = $x->{foo}; $x}) ? 2 : 0;
+ $code -= defined(eval q{no autovivification; my $x; my $y = $x->{foo}; $x})
+ ? 0 : 4;
+ exit $code;
+ RUN
+ is $status, 0, 'loading the pragma in a thread and using it outside doesn\'t segfault';
+}
Added: branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/a0.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/a0.pm?rev=57703&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/a0.pm (added)
+++ branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/a0.pm Sun May 9 00:29:13 2010
@@ -1,0 +1,9 @@
+package autovivification::TestRequired4::a0;
+no autovivification qw/strict fetch/;
+use autovivification::TestRequired4::b0;
+sub error {
+ local $@;
+ autovivification::TestRequired4::b0->get;
+ return $@;
+}
+1;
Added: branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/b0.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/b0.pm?rev=57703&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/b0.pm (added)
+++ branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/b0.pm Sun May 9 00:29:13 2010
@@ -1,0 +1,5 @@
+package autovivification::TestRequired4::b0;
+sub get {
+ eval 'require autovivification::TestRequired4::c0';
+}
+1;
Added: branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/c0.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/c0.pm?rev=57703&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/c0.pm (added)
+++ branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/c0.pm Sun May 9 00:29:13 2010
@@ -1,0 +1,4 @@
+package autovivification::TestRequired4::c0;
+my $x;
+my $y = $x->{foo};
+1;
Added: branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/a0.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/a0.pm?rev=57703&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/a0.pm (added)
+++ branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/a0.pm Sun May 9 00:29:13 2010
@@ -1,0 +1,9 @@
+package autovivification::TestRequired5::a0;
+no autovivification qw/strict fetch/;
+use autovivification::TestRequired5::b0;
+sub error {
+ local $@;
+ autovivification::TestRequired5::b0->get;
+ return $@;
+}
+1;
Added: branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/b0.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/b0.pm?rev=57703&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/b0.pm (added)
+++ branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/b0.pm Sun May 9 00:29:13 2010
@@ -1,0 +1,5 @@
+package autovivification::TestRequired5::b0;
+sub get {
+ eval 'require autovivification::TestRequired5::c0';
+}
+1;
Added: branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/c0.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/c0.pm?rev=57703&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/c0.pm (added)
+++ branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/c0.pm Sun May 9 00:29:13 2010
@@ -1,0 +1,3 @@
+package autovivification::TestRequired5::c0;
+require autovivification::TestRequired5::d0;
+1;
Added: branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/d0.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/d0.pm?rev=57703&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/d0.pm (added)
+++ branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/d0.pm Sun May 9 00:29:13 2010
@@ -1,0 +1,4 @@
+package autovivification::TestRequired5::d0;
+my $x;
+my $y = $x->{foo};
+1;
Added: branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired6.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired6.pm?rev=57703&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired6.pm (added)
+++ branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired6.pm Sun May 9 00:29:13 2010
@@ -1,0 +1,13 @@
+package autovivification::TestRequired6;
+
+sub new { bless {} }
+
+sub bar {
+ exists $main::blurp->{bar};
+}
+
+sub baz {
+ eval q[exists $main::blurp->{baz}];
+}
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list