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, &param);
+
+ 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