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
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
#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)
}
}
-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)
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
+++ /dev/null
-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;
+++ /dev/null
-#!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;
PL_block_type
PL_c9_utf8_dfa_tab
PL_charclass
+PL_check
PL_core_reg_engine
PL_extended_utf8_dfa_tab
PL_fold
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 */
;
#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 */
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
#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);
#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
#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
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
;
#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
}
print $oc <<'END';
-};
+}
#endif
+#ifdef PERL_CHECK_INITED
+;
+#endif /* #ifdef PERL_CHECK_INITED */
#ifndef PERL_GLOBAL_STRUCT_INIT
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);
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. */
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);