fix thread issue with PERL_GLOBAL_STRUCT

The MY_CXT subsystem allows per-thread pseudo-static data storage.
Part of the implementation for this involves each XS module being
assigned a unique index in its my_cxt_index static var when first
loaded.

Because PERL_GLOBAL_STRUCT bans any static vars, under those builds
there is instead a table which maps the MY_CXT_KEY identifying string to
index.

Unfortunately, this table was allocated per-interpreter rather than
globally, meaning if multiple threads tried to load the same XS module,
crashes could ensue.

This manifested itself in failures in
ext/XS-APItest/t/keyword_plugin_threads.t

The fix is relatively straightforward: allocate PL_my_cxt_keys globally
rather than per-interpreter.

Also record the size of this struct in a new var, PL_my_cxt_keys_size,
rather than doing double duty on PL_my_cxt_size.

diff --git a/embedvar.h b/embedvar.h
index 37e4ab1..420664d 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -203,7 +203,6 @@
 #define PL_modcount            (vTHX->Imodcount)
 #define PL_modglobal           (vTHX->Imodglobal)
 #define PL_multideref_pc       (vTHX->Imultideref_pc)
-#define PL_my_cxt_keys         (vTHX->Imy_cxt_keys)
 #define PL_my_cxt_list         (vTHX->Imy_cxt_list)
 #define PL_my_cxt_size         (vTHX->Imy_cxt_size)
 #define PL_na                  (vTHX->Ina)
@@ -426,6 +425,10 @@
 #define PL_Gmy_ctx_mutex       (my_vars->Gmy_ctx_mutex)
 #define PL_my_cxt_index                (my_vars->Gmy_cxt_index)
 #define PL_Gmy_cxt_index       (my_vars->Gmy_cxt_index)
+#define PL_my_cxt_keys         (my_vars->Gmy_cxt_keys)
+#define PL_Gmy_cxt_keys                (my_vars->Gmy_cxt_keys)
+#define PL_my_cxt_keys_size    (my_vars->Gmy_cxt_keys_size)
+#define PL_Gmy_cxt_keys_size   (my_vars->Gmy_cxt_keys_size)
 #define PL_op_mutex            (my_vars->Gop_mutex)
 #define PL_Gop_mutex           (my_vars->Gop_mutex)
 #define PL_op_seq              (my_vars->Gop_seq)

diff --git a/intrpvar.h b/intrpvar.h
index f604ef9..1f69ab2 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -772,9 +772,6 @@ PERLVARI(I, globhook,       globhook_t, NULL)
 #ifdef PERL_IMPLICIT_CONTEXT
 PERLVARI(I, my_cxt_list, void **, NULL) /* per-module array of MY_CXT pointers */
 PERLVARI(I, my_cxt_size, int,  0)      /* size of PL_my_cxt_list */
-#  ifdef PERL_GLOBAL_STRUCT_PRIVATE
-PERLVARI(I, my_cxt_keys, const char **, NULL) /* per-module array of pointers to MY_CXT_KEY constants */
-#  endif
 #endif
 
 #if defined(PERL_IMPLICIT_CONTEXT) || defined(PERL_DEBUG_READONLY_COW)

diff --git a/makedef.pl b/makedef.pl
index 2e4e6dc..dbb7f7d 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -455,6 +455,7 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
                    PL_my_cxt_list
                    PL_my_cxt_size
                    PL_my_cxt_keys
+                   PL_my_cxt_keys_size
                    Perl_croak_nocontext
                    Perl_die_nocontext
                    Perl_deb_nocontext
@@ -536,6 +537,7 @@ unless ($define{'PERL_GLOBAL_STRUCT'}) {
 unless ($define{'PERL_GLOBAL_STRUCT_PRIVATE'}) {
     ++$skip{$_} foreach qw(
                    PL_my_cxt_keys
+                   PL_my_cxt_keys_size
                    Perl_my_cxt_index
                         );
 }

diff --git a/perlapi.h b/perlapi.h
index 6eac8f7..66f5ac5 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -177,6 +177,10 @@ END_EXTERN_C
 #define PL_my_ctx_mutex                (*Perl_Gmy_ctx_mutex_ptr(NULL))
 #undef  PL_my_cxt_index
 #define PL_my_cxt_index                (*Perl_Gmy_cxt_index_ptr(NULL))
+#undef  PL_my_cxt_keys
+#define PL_my_cxt_keys         (*Perl_Gmy_cxt_keys_ptr(NULL))
+#undef  PL_my_cxt_keys_size
+#define PL_my_cxt_keys_size    (*Perl_Gmy_cxt_keys_size_ptr(NULL))
 #undef  PL_op_mutex
 #define PL_op_mutex            (*Perl_Gop_mutex_ptr(NULL))
 #undef  PL_op_seq

diff --git a/perlvars.h b/perlvars.h
index ae34a1e..be56d54 100644 (file)
--- a/perlvars.h
+++ b/perlvars.h
@@ -337,3 +337,13 @@ PERLVARI(G, strategy_socket,     int, 0)   /* doio.c */
 PERLVARI(G, strategy_accept,     int, 0)       /* doio.c */
 PERLVARI(G, strategy_pipe,       int, 0)       /* doio.c */
 PERLVARI(G, strategy_socketpair, int, 0)       /* doio.c */
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#  ifdef PERL_GLOBAL_STRUCT_PRIVATE
+/* per-module array of pointers to MY_CXT_KEY constants.
+ * It simulates each module having a static my_cxt_index var on builds
+ * which don't allow static vars */
+PERLVARI(G, my_cxt_keys, const char **, NULL)
+PERLVARI(G, my_cxt_keys_size, int,     0)      /* size of PL_my_cxt_keys */
+#  endif
+#endif

diff --git a/sv.c b/sv.c
index d7315b2..3575e89 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -15575,16 +15575,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     if (PL_my_cxt_size) {
        Newx(PL_my_cxt_list, PL_my_cxt_size, void *);
        Copy(proto_perl->Imy_cxt_list, PL_my_cxt_list, PL_my_cxt_size, void *);
-#ifdef PERL_GLOBAL_STRUCT_PRIVATE
-       Newx(PL_my_cxt_keys, PL_my_cxt_size, const char *);
-       Copy(proto_perl->Imy_cxt_keys, PL_my_cxt_keys, PL_my_cxt_size, char *);
-#endif
     }
     else {
        PL_my_cxt_list  = (void**)NULL;
-#ifdef PERL_GLOBAL_STRUCT_PRIVATE
-       PL_my_cxt_keys  = (const char**)NULL;
-#endif
     }
     PL_modglobal       = hv_dup_inc(proto_perl->Imodglobal, param);
     PL_custom_op_names  = hv_dup_inc(proto_perl->Icustom_op_names,param);

diff --git a/util.c b/util.c
index ae86a8c..6e1587e 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5290,6 +5290,33 @@ Perl_my_cxt_init(pTHX_ const char *my_cxt_key, size_t size)
         if (index == -1)
             /* this module hasn't been allocated an index yet */
             index = PL_my_cxt_index++;
+
+        /* Store the index in a global MY_CXT_KEY string to index mapping
+         * table. This emulates the perl-module static my_cxt_index var on
+         * builds which don't allow static vars */
+        if (PL_my_cxt_keys_size <= index) {
+            int old_size = PL_my_cxt_keys_size;
+            int i;
+            if (PL_my_cxt_keys_size) {
+                IV new_size = PL_my_cxt_keys_size;
+                while (new_size <= index)
+                    new_size *= 2;
+                PL_my_cxt_keys = (const char **)PerlMemShared_realloc(
+                                        PL_my_cxt_keys,
+                                        new_size * sizeof(const char *));
+                PL_my_cxt_keys_size = new_size;
+            }
+            else {
+                PL_my_cxt_keys_size = 16;
+                PL_my_cxt_keys = (const char **)PerlMemShared_malloc(
+                            PL_my_cxt_keys_size * sizeof(const char *));
+            }
+            for (i = old_size; i < PL_my_cxt_keys_size; i++) {
+                PL_my_cxt_keys[i] = 0;
+            }
+        }
+        PL_my_cxt_keys[index] = my_cxt_key;
+
        MUTEX_UNLOCK(&PL_my_ctx_mutex);
     }
 
@@ -5302,20 +5329,16 @@ Perl_my_cxt_init(pTHX_ const char *my_cxt_key, size_t size)
            while (new_size <= index)
                new_size *= 2;
            Renew(PL_my_cxt_list, new_size, void *);
-           Renew(PL_my_cxt_keys, new_size, const char *);
             PL_my_cxt_size = new_size;
        }
        else {
            PL_my_cxt_size = 16;
            Newx(PL_my_cxt_list, PL_my_cxt_size, void *);
-           Newx(PL_my_cxt_keys, PL_my_cxt_size, const char *);
        }
        for (i = old_size; i < PL_my_cxt_size; i++) {
-           PL_my_cxt_keys[i] = 0;
            PL_my_cxt_list[i] = 0;
        }
     }
-    PL_my_cxt_keys[index] = my_cxt_key;
     /* newSV() allocates one more than needed */
     p = (void*)SvPVX(newSV(size-1));
     PL_my_cxt_list[index] = p;