summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--MANIFEST2
-rw-r--r--embedvar.h3
-rw-r--r--ext/XS-APItest/APItest.xs30
-rw-r--r--ext/XS-APItest/t/Hoisted.pm23
-rw-r--r--ext/XS-APItest/t/pl_check.t27
-rw-r--r--globvar.sym1
-rw-r--r--intrpvar.h1
-rw-r--r--opcode.h14
-rw-r--r--perl.c1
-rw-r--r--perlapi.h2
-rw-r--r--perlvars.h1
-rw-r--r--pod/perldelta.pod4
-rwxr-xr-xregen/opcode.pl14
-rw-r--r--sv.c3
-rw-r--r--util.c7
15 files changed, 37 insertions, 96 deletions
diff --git a/MANIFEST b/MANIFEST
index 9fcc603f61..2903817c31 100644
--- 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 04c2d6b2e6..63a741edb6 100644
--- 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 f682784269..fcaea38da1 100644
--- 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
index a92e26ec63..0000000000
--- 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
index e359ab8700..0000000000
--- 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 1642c88060..dcc65f2e29 100644
--- 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 adb6a48d59..5369292590 100644
--- 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 63a9f9d9d7..c4104dded1 100644
--- 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 0e44598e9c..70424cdbab 100644
--- 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 7304dc31b8..221493437c 100644
--- 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 edc6858e8b..2137554404 100644
--- 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 54392ae3a2..46df260326 100644
--- 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 44541a742d..672f55c368 100755
--- 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 addaa4882b..6a23ae5e9d 100644
--- 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 28e7fa6ce1..861633ea31 100644
--- 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);
View Lorry Controller Status