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 bc6857e4129fc92cfb47098417d5d974c88bdbfb..a36d0a22d46232090ae0b414f1476059f25a10fc 100644 (file)
--- 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 d1a07721d2bd5dffbf8feef94f9b691ae3b9c22b..442f70187a20b4bff4d78c7a755ae73f19862346 100644 (file)
--- 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 6e35ac9b0105c8ee09341170a1c962cedc5215f0..dc55d2ac93555dfbb76b7f3b02b4b3490ef6903a 100644 (file)
--- 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';
+}