Add global hash to handle \p{user-defined}

A global hash has to be specially handled.  The keys can't be shared,
and all the SVs stored into it must be in its thread.  This commit adds
the hash, and initialization, and macros for context change, but doesn't
use them.  The code to deal with this is entirely confined to regcomp.c.

diff --git a/embedvar.h b/embedvar.h
index 79f5bd0..705be5d 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -468,6 +468,10 @@
 #define PL_Gtimesbase          (my_vars->Gtimesbase)
 #define PL_use_safe_putenv     (my_vars->Guse_safe_putenv)
 #define PL_Guse_safe_putenv    (my_vars->Guse_safe_putenv)
+#define PL_user_def_props      (my_vars->Guser_def_props)
+#define PL_Guser_def_props     (my_vars->Guser_def_props)
+#define PL_user_def_props_aTHX (my_vars->Guser_def_props_aTHX)
+#define PL_Guser_def_props_aTHX        (my_vars->Guser_def_props_aTHX)
 #define PL_user_prop_mutex     (my_vars->Guser_prop_mutex)
 #define PL_Guser_prop_mutex    (my_vars->Guser_prop_mutex)
 #define PL_utf8_charname_begin (my_vars->Gutf8_charname_begin)

diff --git a/makedef.pl b/makedef.pl
index 7e22e02..2e4e6dc 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -353,6 +353,7 @@ if ($define{'PERL_USE_SAFE_PUTENV'}) {
 unless ($define{'USE_ITHREADS'}) {
     ++$skip{PL_thr_key};
     ++$skip{PL_user_prop_mutex};
+    ++$skip{PL_user_def_props_aTHX};
 }
 
 # USE_5005THREADS symbols. Kept as reference for easier removal

diff --git a/perlapi.h b/perlapi.h
index 6d8ebf8..f08bd60 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -215,6 +215,10 @@ END_EXTERN_C
 #define PL_timesbase           (*Perl_Gtimesbase_ptr(NULL))
 #undef  PL_use_safe_putenv
 #define PL_use_safe_putenv     (*Perl_Guse_safe_putenv_ptr(NULL))
+#undef  PL_user_def_props
+#define PL_user_def_props      (*Perl_Guser_def_props_ptr(NULL))
+#undef  PL_user_def_props_aTHX
+#define PL_user_def_props_aTHX (*Perl_Guser_def_props_aTHX_ptr(NULL))
 #undef  PL_user_prop_mutex
 #define PL_user_prop_mutex     (*Perl_Guser_prop_mutex_ptr(NULL))
 #undef  PL_utf8_charname_begin

diff --git a/perlvars.h b/perlvars.h
index 331105e..51c939e 100644 (file)
--- a/perlvars.h
+++ b/perlvars.h
@@ -307,8 +307,15 @@ PERLVAR(G, utf8_mark,      SV *)
 PERLVAR(G, InBitmap,   SV *)
 PERLVAR(G, CCC_non0_non230,    SV *)
 
+/* Definitions of user-defined \p{} properties, as the subs that define them
+ * are only called once */
+PERLVARI(G, user_def_props,    HV *, NULL)
+
 #if defined(USE_ITHREADS)
-PERLVAR(G, user_prop_mutex, perl_mutex)
+PERLVAR(G, user_def_props_aTHX, PerlInterpreter *)  /* aTHX that user_def_props
+                                                       was defined in */
+PERLVAR(G, user_prop_mutex, perl_mutex)    /* Mutex for manipulating
+                                              PL_user_defined_properties */
 #endif
 
 /* Everything that folds to a given character, for case insensitivity regex

diff --git a/regcomp.c b/regcomp.c
index 98e9fbc..7d4dcdc 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -21928,6 +21928,15 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
 void
 Perl_init_uniprops(pTHX)
 {
+    PL_user_def_props = newHV();
+
+#ifdef USE_ITHREADS
+
+    HvSHAREKEYS_off(PL_user_def_props);
+    PL_user_def_props_aTHX = aTHX;
+
+#endif
+
     /* Set up the inversion list global variables */
 
     PL_XPosix_ptrs[_CC_ASCII] = _new_invlist_C_array(uni_prop_ptrs[UNI_ASCII]);
@@ -22007,6 +22016,22 @@ Perl_init_uniprops(pTHX)
 #endif
 }
 
+#ifdef USE_ITHREADS
+#  define DECLARATION_FOR_GLOBAL_CONTEXT                                    \
+                                        PerlInterpreter * save_aTHX = aTHX;
+#  define SWITCH_TO_GLOBAL_CONTEXT                                          \
+                           PERL_SET_CONTEXT((aTHX = PL_user_def_props_aTHX))
+#  define RESTORE_CONTEXT  PERL_SET_CONTEXT((aTHX = save_aTHX));
+#  define CUR_CONTEXT      aTHX
+#  define ORIGINAL_CONTEXT save_aTHX
+#else
+#  define DECLARATION_FOR_GLOBAL_CONTEXT
+#  define SWITCH_TO_GLOBAL_CONTEXT          NOOP
+#  define RESTORE_CONTEXT                   NOOP
+#  define CUR_CONTEXT                       NULL
+#  define ORIGINAL_CONTEXT                  NULL
+#endif
+
 SV *
 Perl_parse_uniprop_string(pTHX_ const char * const name, const Size_t name_len,
                                 const bool to_fold, bool * invert)