B::check_av() ; B::Deparse for CHECK blocks

Message-Id: <20020827233653.535bc211.rgarciasuarez@free.fr>

p4raw-id: //depot/perl@17804

diff --git a/embedvar.h b/embedvar.h
index d6a30fb..1d76394 100644 (file)
--- 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 ed7cf73..564b675 100644 (file)
--- 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 83c9c4a..d7ae0f1 100644 (file)
--- 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 c985896..6a57872 100644 (file)
--- 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 f98e348..a957e5b 100644 (file)
--- 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. */
-

diff --git a/perl.c b/perl.c
index 5aae0c8..393ad4f 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -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);
        }

diff --git a/perlapi.h b/perlapi.h
index 0e0fef2..ddeeab3 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -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

diff --git a/sv.c b/sv.c
index c8d11db..aad6c34 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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);