Revert "Move PL_check to the interp vars to fix threading issues"

and the associated commits, at least until a way to make
wrap_op_checker() work is available.

diff --git a/MANIFEST b/MANIFEST
index 9fcc603..2903817 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4438,7 +4438,6 @@ ext/XS-APItest/t/handy08.t        XS::APItest: tests for handy.h
 ext/XS-APItest/t/handy09.t     XS::APItest: tests for handy.h
 ext/XS-APItest/t/handy_base.pl XS::APItest: tests for handy.h
 ext/XS-APItest/t/hash.t                XS::APItest: tests for hash related APIs
-ext/XS-APItest/t/Hoisted.pm    used by pl_check.t
 ext/XS-APItest/t/join_with_space.t     test op_convert_list
 ext/XS-APItest/t/keyword_multiline.t   test keyword plugin parsing across lines
 ext/XS-APItest/t/keyword_plugin.t      test keyword plugin mechanism
@@ -4468,7 +4467,6 @@ ext/XS-APItest/t/op_list.t        test OP list construction API
 ext/XS-APItest/t/overload.t    XS::APItest: tests for overload related APIs
 ext/XS-APItest/t/pad_scalar.t  Test pad_findmy_* functions
 ext/XS-APItest/t/peep.t                test PL_peepp/PL_rpeepp
-ext/XS-APItest/t/pl_check.t    Test PL_check thread safety
 ext/XS-APItest/t/pmflag.t      Test removal of Perl_pmflag()
 ext/XS-APItest/t/postinc.t     test op_lvalue()
 ext/XS-APItest/t/printf.t      XS::APItest extension

diff --git a/embedvar.h b/embedvar.h
index 04c2d6b..63a741e 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -88,7 +88,6 @@
 #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)
@@ -380,6 +379,8 @@
 #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/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index f682784..fcaea38 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -742,26 +742,6 @@ THX_ck_entersub_pad_scalar(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
     }
 }
 
-static OP *
-hoist_pp_nextstate(pTHX)
-{
-    dVAR;
-    COP *old_curcop = PL_curcop;
-    OP *next = PL_ppaddr[PL_op->op_type](aTHX);
-    PL_curcop = old_curcop;
-    return next;
-}
-
-static OP *
-hoist_ck_lineseq(pTHX_ OP *o)
-{
-    OP *kid = cBINOPo->op_first;
-    for (; kid; kid = OpSIBLING(kid))
-       if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
-           kid->op_ppaddr = hoist_pp_nextstate;
-    return o;
-}
-
 /** RPN keyword parser **/
 
 #define sv_is_glob(sv) (SvTYPE(sv) == SVt_PVGV)
@@ -4517,16 +4497,6 @@ PerlIO_stdin()
 FILE *
 PerlIO_exportFILE(PerlIO *f, const char *mode)
 
-SV *
-create_hoisted_subs(const char *code)
-    CODE:
-       OP *(*old_ck_lineseq)(pTHX_ OP *) = PL_check[OP_LINESEQ];
-       PL_check[OP_LINESEQ] = hoist_ck_lineseq;
-       RETVAL = SvREFCNT_inc(eval_pv(code,FALSE));
-       PL_check[OP_LINESEQ] = old_ck_lineseq;
-    OUTPUT:
-       RETVAL
-
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int

diff --git a/ext/XS-APItest/t/Hoisted.pm b/ext/XS-APItest/t/Hoisted.pm
deleted file mode 100644 (file)
index a92e26e..0000000
--- a/ext/XS-APItest/t/Hoisted.pm
+++ /dev/null
@@ -1,23 +0,0 @@
-package Hoisted;
-use XS::APItest;
-use Carp;
-
-XS::APItest::create_hoisted_subs(<<'CODE');
-sub getline {
-    @_ == 1 or croak 'usage: $io->getline()';
-    my $this = shift;
-    return scalar <$this>;
-}
-
-sub getlines {
-    @_ == 1 or croak 'usage: $io->getlines()';
-    wantarray or
-       croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
-    my $this = shift;
-    return <$this>;
-}
-
-1;
-CODE
-
-1;

diff --git a/ext/XS-APItest/t/pl_check.t b/ext/XS-APItest/t/pl_check.t
deleted file mode 100644 (file)
index e359ab8..0000000
--- a/ext/XS-APItest/t/pl_check.t
+++ /dev/null
@@ -1,27 +0,0 @@
-#!perl
-use strict;
-use Config;
-
-# this doesn't work with Test::More
-BEGIN {
-    require '../../t/test.pl';
-}
-BEGIN { plan skip_all => 'no threads' unless $Config{useithreads} }
-
-use threads;
-
-# do not use XS::APItest in this test
-
-use constant thread_count => 20;
-
-plan tests => thread_count;
-
-push @INC, "t";
-my @threads;
-for (1..thread_count) {
-    push @threads, threads->create(sub {
-        require Hoisted;
-        return 1;
-    });
-}
-ok $_->join for @threads;

diff --git a/globvar.sym b/globvar.sym
index 1642c88..dcc65f2 100644 (file)
--- a/globvar.sym
+++ b/globvar.sym
@@ -10,6 +10,7 @@ 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 adb6a48..5369292 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -496,7 +496,6 @@ 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 63a9f9d..c4104dd 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1374,8 +1374,15 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
 ;
 #endif
 
-#ifdef PERL_IN_PERL_C
+#ifdef PERL_GLOBAL_STRUCT_INIT
+#  define PERL_CHECK_INITED
 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 */
@@ -1775,8 +1782,11 @@ static const Perl_check_t Gcheck[]
        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 0e44598..70424cd 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -458,7 +458,6 @@ 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 7304dc3..2214934 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -103,6 +103,8 @@ 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 edc6858..2137554 100644 (file)
--- a/perlvars.h
+++ b/perlvars.h
@@ -155,6 +155,7 @@ 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/pod/perldelta.pod b/pod/perldelta.pod
index 54392ae..46df260 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -404,10 +404,6 @@ than by F<feature.pm> updating C<${^FEATURE_BITS}>, which has been
 removed.  This allows perl code to save and restore the contents of
 C<%^H> without also having to manage C<${^FEATURE_BITS}>.  [#17337]
 
-=item *
-
-C<PL_check> is now interpreter-local rather than global.  [#14816]
-
 =back
 
 =head1 Known Problems

diff --git a/regen/opcode.pl b/regen/opcode.pl
index 44541a7..672f55c 100755 (executable)
--- a/regen/opcode.pl
+++ b/regen/opcode.pl
@@ -1061,8 +1061,15 @@ print $oc <<'END';
 ;
 #endif
 
-#ifdef PERL_IN_PERL_C
+#ifdef PERL_GLOBAL_STRUCT_INIT
+#  define PERL_CHECK_INITED
 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
 
@@ -1071,8 +1078,11 @@ 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 addaa48..6a23ae5 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -15574,9 +15574,6 @@ 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/util.c b/util.c
index 28e7fa6..861633e 100644 (file)
--- a/util.c
+++ b/util.c
@@ -4630,6 +4630,7 @@ 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. */
@@ -4658,7 +4659,13 @@ 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);