From: Vincent Pit <vince@profvince.com>
Date: Sat, 4 Oct 2014 16:08:16 +0000 (+0200)
Subject: Do nothing after that the thread local storage has been freed
X-Git-Tag: v0.13~5
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=ff9984e126b58e6eea61a3815ba4e453d426f085;p=perl%2Fmodules%2Fautovivification.git

Do nothing after that the thread local storage has been freed

This de facto disables the pragma for code eval'd during global
destruction of a thread or a pseudo-fork.
---

diff --git a/autovivification.xs b/autovivification.xs
index bc6857e..a36d0a2 100644
--- a/autovivification.xs
+++ b/autovivification.xs
@@ -295,19 +295,22 @@ get_enclosing_cv:
 STATIC SV *a_tag(pTHX_ UV bits) {
 #define a_tag(B) a_tag(aTHX_ (B))
  a_hint_t *h;
+#if A_THREADSAFE
+ dMY_CXT;
+
+ if (!MY_CXT.tbl)
+  return newSViv(0);
+#endif /* A_THREADSAFE */
 
  h              = PerlMemShared_malloc(sizeof *h);
  h->bits        = bits;
  h->require_tag = a_require_tag();
 
 #if A_THREADSAFE
- {
-  dMY_CXT;
-  /* 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);
- }
+ /* 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));
@@ -316,16 +319,19 @@ STATIC SV *a_tag(pTHX_ UV bits) {
 STATIC UV a_detag(pTHX_ const SV *hint) {
 #define a_detag(H) a_detag(aTHX_ (H))
  a_hint_t *h;
+#if A_THREADSAFE
+ dMY_CXT;
+
+ if (!MY_CXT.tbl)
+  return 0;
+#endif /* A_THREADSAFE */
 
  if (!(hint && SvIOK(hint)))
   return 0;
 
  h = INT2PTR(a_hint_t *, SvIVX(hint));
 #if A_THREADSAFE
- {
-  dMY_CXT;
-  h = ptable_fetch(MY_CXT.tbl, h);
- }
+ h = ptable_fetch(MY_CXT.tbl, h);
 #endif /* A_THREADSAFE */
 
  if (a_require_tag() != h->require_tag)
@@ -1107,9 +1113,11 @@ STATIC void a_peep(pTHX_ OP *o) {
 
  a_old_peep(aTHX_ o);
 
- ptable_seen_clear(seen);
- a_peep_rec(o);
- ptable_seen_clear(seen);
+ if (seen) {
+  ptable_seen_clear(seen);
+  a_peep_rec(o);
+  ptable_seen_clear(seen);
+ }
 }
 
 /* --- Interpreter setup/teardown ------------------------------------------ */
diff --git a/lib/autovivification.pm b/lib/autovivification.pm
index d1a0772..442f701 100644
--- a/lib/autovivification.pm
+++ b/lib/autovivification.pm
@@ -204,6 +204,8 @@ The pragma doesn't apply when one dereferences the returned value of an array or
 This syntax is valid Perl, yet it is discouraged as the slice is here useless since the dereferencing enforces scalar context.
 If warnings are turned on, Perl will complain about one-element slices.
 
+Autovivifications that happen in code C<eval>'d during the global destruction phase of a spawned thread or pseudo-fork (the processes used internally for the C<fork> emulation on Windows) are not reported.
+
 =head1 DEPENDENCIES
 
 L<perl> 5.8.3.
diff --git a/t/51-threads-teardown.t b/t/51-threads-teardown.t
index 6e35ac9..dc55d2a 100644
--- a/t/51-threads-teardown.t
+++ b/t/51-threads-teardown.t
@@ -7,7 +7,7 @@ use lib 't/lib';
 use VPIT::TestHelpers;
 use autovivification::TestThreads;
 
-use Test::Leaner tests => 1;
+use Test::Leaner tests => 2;
 
 SKIP:
 {
@@ -27,3 +27,21 @@ SKIP:
  RUN
  is $status, 0, 'loading the pragma in a thread and using it outside doesn\'t segfault';
 }
+
+{
+ my $status = run_perl <<' RUN';
+  use threads;
+  BEGIN { require autovivification; }
+  sub X::DESTROY {
+   eval 'no autovivification; my $x; my $y = $x->{foo}{bar}; use autovivification; my $z = $x->{a}{b}{c};';
+   exit 1 if $@;
+  }
+  threads->create(sub {
+   my $x = bless { }, 'X';
+   $x->{self} = $x;
+   return;
+  })->join;
+  exit $code;
+ RUN
+ is $status, 0, 'autovivification can be loaded in eval STRING during global destruction at the end of a thread';
+}