diff options
| -rw-r--r-- | embedvar.h | 3 | ||||
| -rw-r--r-- | ext/B/B.pm | 6 | ||||
| -rw-r--r-- | ext/B/B.xs | 4 | ||||
| -rw-r--r-- | ext/B/B/Deparse.pm | 3 | ||||
| -rw-r--r-- | intrpvar.h | 3 | ||||
| -rw-r--r-- | perl.c | 18 | ||||
| -rw-r--r-- | perlapi.h | 2 | ||||
| -rw-r--r-- | sv.c | 1 |
8 files changed, 33 insertions, 7 deletions
diff --git a/embedvar.h b/embedvar.h index d6a30fbfad..1d76394729 100644 --- a/embedvar.h +++ b/embedvar.h @@ -210,6 +210,7 @@ #define PL_bufend (PERL_GET_INTERP->Ibufend) #define PL_bufptr (PERL_GET_INTERP->Ibufptr) #define PL_checkav (PERL_GET_INTERP->Icheckav) +#define PL_checkav_save (PERL_GET_INTERP->Icheckav_save) #define PL_collation_ix (PERL_GET_INTERP->Icollation_ix) #define PL_collation_name (PERL_GET_INTERP->Icollation_name) #define PL_collation_standard (PERL_GET_INTERP->Icollation_standard) @@ -512,6 +513,7 @@ #define PL_bufend (vTHX->Ibufend) #define PL_bufptr (vTHX->Ibufptr) #define PL_checkav (vTHX->Icheckav) +#define PL_checkav_save (vTHX->Icheckav_save) #define PL_collation_ix (vTHX->Icollation_ix) #define PL_collation_name (vTHX->Icollation_name) #define PL_collation_standard (vTHX->Icollation_standard) @@ -817,6 +819,7 @@ #define PL_Ibufend PL_bufend #define PL_Ibufptr PL_bufptr #define PL_Icheckav PL_checkav +#define PL_Icheckav_save PL_checkav_save #define PL_Icollation_ix PL_collation_ix #define PL_Icollation_name PL_collation_name #define PL_Icollation_standard PL_collation_standard diff --git a/ext/B/B.pm b/ext/B/B.pm index ed7cf7318c..564b6758cc 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -21,7 +21,7 @@ require Exporter; amagic_generation perlstring walkoptree_slow walkoptree walkoptree_exec walksymtable parents comppadlist sv_undef compile_stats timing_info - begin_av init_av end_av regex_padav); + begin_av init_av check_av end_av regex_padav); sub OPf_KIDS (); use strict; @@ -374,6 +374,10 @@ Returns the SV object corresponding to the C variable C<amagic_generation>. Returns the AV object (i.e. in class B::AV) representing INIT blocks. +=item check_av + +Returns the AV object (i.e. in class B::AV) representing CHECK blocks. + =item begin_av Returns the AV object (i.e. in class B::AV) representing BEGIN blocks. diff --git a/ext/B/B.xs b/ext/B/B.xs index 83c9c4ad44..d7ae0f1101 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -446,6 +446,7 @@ BOOT: #define B_main_cv() PL_main_cv #define B_init_av() PL_initav +#define B_check_av() PL_checkav_save #define B_begin_av() PL_beginav_save #define B_end_av() PL_endav #define B_main_root() PL_main_root @@ -463,6 +464,9 @@ B::AV B_init_av() B::AV +B_check_av() + +B::AV B_begin_av() B::AV diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index c98589691c..6a578725e1 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -553,9 +553,10 @@ sub compile { print qq(BEGIN { \$/ = $fs; \$\\ = $bs; }\n); } my @BEGINs = B::begin_av->isa("B::AV") ? B::begin_av->ARRAY : (); + my @CHECKs = B::check_av->isa("B::AV") ? B::check_av->ARRAY : (); my @INITs = B::init_av->isa("B::AV") ? B::init_av->ARRAY : (); my @ENDs = B::end_av->isa("B::AV") ? B::end_av->ARRAY : (); - for my $block (@BEGINs, @INITs, @ENDs) { + for my $block (@BEGINs, @CHECKs, @INITs, @ENDs) { $self->todo($block, 0); } $self->stash_subs(); diff --git a/intrpvar.h b/intrpvar.h index f98e3484f7..a957e5bc29 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -522,7 +522,8 @@ PERLVAR(Iutf8_idcont, SV *) PERLVAR(Isort_RealCmp, SVCOMPARE_t) +PERLVARI(Icheckav_save, AV*, Nullav) /* save CHECK{}s when compiling */ + /* New variables must be added to the very end for binary compatibility. * XSUB.h provides wrapper functions via perlapi.h that make this * irrelevant, but not all code may be expected to #include XSUB.h. */ - @@ -628,11 +628,13 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_beginav_save); SvREFCNT_dec(PL_endav); SvREFCNT_dec(PL_checkav); + SvREFCNT_dec(PL_checkav_save); SvREFCNT_dec(PL_initav); PL_beginav = Nullav; PL_beginav_save = Nullav; PL_endav = Nullav; PL_checkav = Nullav; + PL_checkav_save = Nullav; PL_initav = Nullav; /* shortcuts just get cleared */ @@ -4007,11 +4009,19 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) while (AvFILL(paramList) >= 0) { cv = (CV*)av_shift(paramList); - if (PL_savebegin && (paramList == PL_beginav)) { + if (PL_savebegin) { + if (paramList == PL_beginav) { /* save PL_beginav for compiler */ - if (! PL_beginav_save) - PL_beginav_save = newAV(); - av_push(PL_beginav_save, (SV*)cv); + if (! PL_beginav_save) + PL_beginav_save = newAV(); + av_push(PL_beginav_save, (SV*)cv); + } + else if (paramList == PL_checkav) { + /* save PL_checkav for compiler */ + if (! PL_checkav_save) + PL_checkav_save = newAV(); + av_push(PL_checkav_save, (SV*)cv); + } } else { SAVEFREESV(cv); } @@ -148,6 +148,8 @@ END_EXTERN_C #define PL_bufptr (*Perl_Ibufptr_ptr(aTHX)) #undef PL_checkav #define PL_checkav (*Perl_Icheckav_ptr(aTHX)) +#undef PL_checkav_save +#define PL_checkav_save (*Perl_Icheckav_save_ptr(aTHX)) #undef PL_collation_ix #define PL_collation_ix (*Perl_Icollation_ix_ptr(aTHX)) #undef PL_collation_name @@ -10233,6 +10233,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, 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); PL_endav = av_dup_inc(proto_perl->Iendav, param); PL_checkav = av_dup_inc(proto_perl->Icheckav, param); PL_initav = av_dup_inc(proto_perl->Iinitav, param); |