Move PL_check to the interp vars to fix threading issues

Fixes issue #14816

11 files changed, 36 insertions, 37 deletions

diff --git a/embedvar.h b/embedvar.h
index 63a741edb6..04c2d6b2e6 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -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)
@@ -379,8 +380,6 @@
 #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)
diff --git a/globvar.sym b/globvar.sym
index dcc65f2e29..1642c88060 100644
--- a/globvar.sym
+++ b/globvar.sym
@@ -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
diff --git a/intrpvar.h b/intrpvar.h
index 5369292590..adb6a48d59 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -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 */
diff --git a/opcode.h b/opcode.h
index c4104dded1..63a9f9d9d7 100644
--- 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 70424cdbab..0e44598e9c 100644
--- 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);
diff --git a/perlapi.h b/perlapi.h
index 221493437c..7304dc31b8 100644
--- 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
diff --git a/perlvars.h b/perlvars.h
index 2137554404..edc6858e8b 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -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
 
diff --git a/regen/opcode.pl b/regen/opcode.pl
index 672f55c368..44541a742d 100755
--- a/regen/opcode.pl
+++ b/regen/opcode.pl
@@ -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 6a23ae5e9d..addaa4882b 100644
--- 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
index 0000000000..ccb83a74cc
--- /dev/null
+++ b/t/io/handle.t
@@ -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 861633ea31..28e7fa6ce1 100644
--- 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);