This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move PL_check to the interp vars to fix threading issues
authorStefan Seifert <nine@detonation.org>
Wed, 30 Oct 2019 15:23:01 +0000 (16:23 +0100)
committerTony Cook <tony@develop-help.com>
Thu, 12 Dec 2019 00:35:20 +0000 (11:35 +1100)
Fixes issue #14816

embedvar.h
globvar.sym
intrpvar.h
opcode.h
perl.c
perlapi.h
perlvars.h
regen/opcode.pl
sv.c
t/io/handle.t [new file with mode: 0644]
util.c

index 63a741e..04c2d6b 100644 (file)
@@ -88,6 +88,7 @@
 #define PL_body_roots          (vTHX->Ibody_roots)
 #define PL_bodytarget          (vTHX->Ibodytarget)
 #define PL_breakable_sub_gen   (vTHX->Ibreakable_sub_gen)
+#define PL_check               (vTHX->Icheck)
 #define PL_checkav             (vTHX->Icheckav)
 #define PL_checkav_save                (vTHX->Icheckav_save)
 #define PL_chopset             (vTHX->Ichopset)
 #define PL_GC_locale_obj       (my_vars->GC_locale_obj)
 #define PL_appctx              (my_vars->Gappctx)
 #define PL_Gappctx             (my_vars->Gappctx)
-#define PL_check               (my_vars->Gcheck)
-#define PL_Gcheck              (my_vars->Gcheck)
 #define PL_check_mutex         (my_vars->Gcheck_mutex)
 #define PL_Gcheck_mutex                (my_vars->Gcheck_mutex)
 #define PL_csighandler1p       (my_vars->Gcsighandler1p)
index dcc65f2..1642c88 100644 (file)
@@ -10,7 +10,6 @@ PL_bitcount
 PL_block_type
 PL_c9_utf8_dfa_tab
 PL_charclass
-PL_check
 PL_core_reg_engine
 PL_extended_utf8_dfa_tab
 PL_fold
index 5369292..adb6a48 100644 (file)
@@ -496,6 +496,7 @@ PERLVAR(I, endav,   AV *)           /* names of END subroutines */
 PERLVAR(I, unitcheckav,        AV *)           /* names of UNITCHECK subroutines */
 PERLVAR(I, checkav,    AV *)           /* names of CHECK subroutines */
 PERLVAR(I, initav,     AV *)           /* names of INIT subroutines */
+PERLVARA(I, check, MAXO, Perl_check_t)  /* functions to call during CHECK phase */
 
 /* subprocess state */
 PERLVAR(I, fdpid,      AV *)           /* keep fd-to-pid mappings for my_popen */
index c4104dd..63a9f9d 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1374,15 +1374,8 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
 ;
 #endif
 
-#ifdef PERL_GLOBAL_STRUCT_INIT
-#  define PERL_CHECK_INITED
+#ifdef PERL_IN_PERL_C
 static const Perl_check_t Gcheck[]
-#elif !defined(PERL_GLOBAL_STRUCT)
-#  define PERL_CHECK_INITED
-EXT Perl_check_t PL_check[] /* or perlvars.h */
-#endif
-#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
-#  define PERL_CHECK_INITED
 = {
        Perl_ck_null,           /* null */
        Perl_ck_null,           /* stub */
@@ -1782,11 +1775,8 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        Perl_ck_null,           /* lvavref */
        Perl_ck_null,           /* anonconst */
        Perl_ck_isa,            /* isa */
-}
+};
 #endif
-#ifdef PERL_CHECK_INITED
-;
-#endif /* #ifdef PERL_CHECK_INITED */
 
 #ifndef PERL_GLOBAL_STRUCT_INIT
 
diff --git a/perl.c b/perl.c
index 70424cd..0e44598 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -458,6 +458,7 @@ perl_construct(pTHXx)
 #ifdef USE_POSIX_2008_LOCALE
     PL_C_locale_obj = newlocale(LC_ALL_MASK, "C", NULL);
 #endif
+    Copy(Gcheck,  PL_check,  MAXO,  Perl_check_t);
 
     ENTER;
     init_i18nl10n(1);
index 2214934..7304dc3 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -103,8 +103,6 @@ END_EXTERN_C
 #define PL_C_locale_obj                (*Perl_GC_locale_obj_ptr(NULL))
 #undef  PL_appctx
 #define PL_appctx              (*Perl_Gappctx_ptr(NULL))
-#undef  PL_check
-#define PL_check               (*Perl_Gcheck_ptr(NULL))
 #undef  PL_check_mutex
 #define PL_check_mutex         (*Perl_Gcheck_mutex_ptr(NULL))
 #undef  PL_csighandler1p
index 2137554..edc6858 100644 (file)
@@ -155,7 +155,6 @@ PERLVAR(G, check_mutex,     perl_mutex)     /* Mutex for PL_check */
 #endif
 #ifdef PERL_GLOBAL_STRUCT 
 PERLVAR(G, ppaddr,     Perl_ppaddr_t *) /* or opcode.h */
-PERLVAR(G, check,      Perl_check_t *) /* or opcode.h */
 PERLVARA(G, fold_locale, 256, unsigned char) /* or perl.h */
 #endif
 
index 672f55c..44541a7 100755 (executable)
@@ -1061,15 +1061,8 @@ print $oc <<'END';
 ;
 #endif
 
-#ifdef PERL_GLOBAL_STRUCT_INIT
-#  define PERL_CHECK_INITED
+#ifdef PERL_IN_PERL_C
 static const Perl_check_t Gcheck[]
-#elif !defined(PERL_GLOBAL_STRUCT)
-#  define PERL_CHECK_INITED
-EXT Perl_check_t PL_check[] /* or perlvars.h */
-#endif
-#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
-#  define PERL_CHECK_INITED
 = {
 END
 
@@ -1078,11 +1071,8 @@ for (@ops) {
 }
 
 print $oc <<'END';
-}
+};
 #endif
-#ifdef PERL_CHECK_INITED
-;
-#endif /* #ifdef PERL_CHECK_INITED */
 
 #ifndef PERL_GLOBAL_STRUCT_INIT
 
diff --git a/sv.c b/sv.c
index 6a23ae5..addaa48 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -15574,6 +15574,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_globalstash     = hv_dup(proto_perl->Iglobalstash, param);
     PL_curstname       = sv_dup_inc(proto_perl->Icurstname, param);
 
+    /* Add PL_check here */
+    Copy(proto_perl->Icheck,  PL_check,  PL_maxo,  Perl_check_t);
+
     PL_beginav         = av_dup_inc(proto_perl->Ibeginav, param);
     PL_beginav_save    = av_dup_inc(proto_perl->Ibeginav_save, param);
     PL_checkav_save    = av_dup_inc(proto_perl->Icheckav_save, param);
diff --git a/t/io/handle.t b/t/io/handle.t
new file mode 100644 (file)
index 0000000..ccb83a7
--- /dev/null
@@ -0,0 +1,26 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc('../lib');
+    skip_all_if_miniperl("miniperl can't load IO::File");
+}
+
+$|  = 1;
+use warnings;
+use Config;
+use threads;
+
+use constant thread_count => 20;
+
+plan tests => thread_count;
+
+my @threads;
+for (1..thread_count) {
+    push @threads, threads->create(sub {
+        require IO::Handle;
+        return 1;
+    });
+}
+ok $_->join for @threads;
diff --git a/util.c b/util.c
index 861633e..28e7fa6 100644 (file)
--- a/util.c
+++ b/util.c
@@ -4630,7 +4630,6 @@ Perl_init_global_struct(pTHX)
     struct perl_vars *plvarsp = NULL;
 # ifdef PERL_GLOBAL_STRUCT
     const IV nppaddr = C_ARRAY_LENGTH(Gppaddr);
-    const IV ncheck  = C_ARRAY_LENGTH(Gcheck);
     PERL_UNUSED_CONTEXT;
 #  ifdef PERL_GLOBAL_STRUCT_PRIVATE
     /* PerlMem_malloc() because can't use even safesysmalloc() this early. */
@@ -4659,13 +4658,7 @@ Perl_init_global_struct(pTHX)
        PerlMem_malloc(nppaddr * sizeof(Perl_ppaddr_t));
     if (!plvarsp->Gppaddr)
         exit(1);
-    plvarsp->Gcheck  =
-       (Perl_check_t*)
-       PerlMem_malloc(ncheck  * sizeof(Perl_check_t));
-    if (!plvarsp->Gcheck)
-        exit(1);
     Copy(Gppaddr, plvarsp->Gppaddr, nppaddr, Perl_ppaddr_t); 
-    Copy(Gcheck,  plvarsp->Gcheck,  ncheck,  Perl_check_t); 
 #  endif
 #  ifdef PERL_SET_VARS
     PERL_SET_VARS(plvarsp);