B:: changes for UNITCHECK blocks

Message-ID: <20061020010520.GC12290@the.earth.li>

p4raw-id: //depot/perl@29062

diff --git a/ext/B/B.pm b/ext/B/B.pm
index b28c64c..e8d7715 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -7,7 +7,7 @@
 #
 package B;
 
-our $VERSION = '1.11';
+our $VERSION = '1.12';
 
 use XSLoader ();
 require Exporter;
@@ -21,8 +21,8 @@ require Exporter;
                sub_generation amagic_generation perlstring
                walkoptree_slow walkoptree walkoptree_exec walksymtable
                parents comppadlist sv_undef compile_stats timing_info
-               begin_av init_av check_av end_av regex_padav dowarn
-               defstash curstash warnhook diehook inc_gv
+               begin_av init_av unitcheck_av check_av end_av regex_padav
+               dowarn defstash curstash warnhook diehook inc_gv
                );
 
 sub OPf_KIDS ();
@@ -384,6 +384,10 @@ Returns the AV object (i.e. in class B::AV) representing INIT blocks.
 
 Returns the AV object (i.e. in class B::AV) representing CHECK blocks.
 
+=item unitcheck_av
+
+Returns the AV object (i.e. in class B::AV) representing UNITCHECK 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 2eedb95..9e6a8f0 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -590,6 +590,7 @@ BOOT:
 #define B_init_av()    PL_initav
 #define B_inc_gv()     PL_incgv
 #define B_check_av()   PL_checkav_save
+#define B_unitcheck_av()       PL_unitcheckav_save
 #define B_begin_av()   PL_beginav_save
 #define B_end_av()     PL_endav
 #define B_main_root()  PL_main_root
@@ -615,6 +616,9 @@ B::AV
 B_check_av()
 
 B::AV
+B_unitcheck_av()
+
+B::AV
 B_begin_av()
 
 B::AV

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 38c8c0a..9171caf 100644 (file)
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
 
 use Exporter (); # use #5
 
-our $VERSION   = "0.69";
+our $VERSION   = "0.70";
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw( set_style set_style_standard add_callback
                     concise_subref concise_cv concise_main
@@ -321,6 +321,10 @@ sub compile {
                concise_specials("CHECK", $order,
                                 B::check_av->isa("B::AV") ?
                                 B::check_av->ARRAY : ());
+           } elsif ($objname eq "UNITCHECK") {
+               concise_specials("UNITCHECK", $order,
+                                B::unitcheck_av->isa("B::AV") ?
+                                B::unitcheck_av->ARRAY : ());
            } elsif ($objname eq "END") {
                concise_specials("END", $order,
                                 B::end_av->isa("B::AV") ?
@@ -1051,8 +1055,8 @@ Arguments that don't start with a hyphen are taken to be the names of
 subroutines to print the OPs of; if no such functions are specified,
 the main body of the program (outside any subroutines, and not
 including use'd or require'd files) is rendered.  Passing C<BEGIN>,
-C<CHECK>, C<INIT>, or C<END> will cause all of the corresponding
-special blocks to be printed.
+C<UNITCHECK>, C<CHECK>, C<INIT>, or C<END> will cause all of the
+corresponding special blocks to be printed.
 
 Options affect how things are rendered (ie printed).  They're presented
 here by their visual effect, 1st being strongest.  They're grouped

diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 635d5b5..3bfd0ce 100644 (file)
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -20,7 +20,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
          CVf_METHOD CVf_LOCKED CVf_LVALUE CVf_ASSERTION
         PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_SKIPWHITE
         PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED);
-$VERSION = 0.77;
+$VERSION = 0.78;
 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
@@ -630,10 +630,13 @@ sub compile {
            print qq(BEGIN { \$/ = $fs; \$\\ = $bs; }\n);
        }
        my @BEGINs  = B::begin_av->isa("B::AV") ? B::begin_av->ARRAY : ();
+       my @UNITCHECKs = B::unitcheck_av->isa("B::AV")
+           ? B::unitcheck_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, @CHECKs, @INITs, @ENDs) {
+       for my $block (@BEGINs, @UNITCHECKs, @CHECKs, @INITs, @ENDs) {
            $self->todo($block, 0);
        }
        $self->stash_subs();

diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index f0c7a70..17f9df4 100644 (file)
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -117,7 +117,7 @@ use Getopt::Std;
 use Carp;
 use Test::More tests => ( # per-pkg tests (function ct + require_ok)
                          40 + 16       # Data::Dumper, Digest::MD5
-                         + 515 + 235   # B::Deparse, B
+                         + 515 + 236   # B::Deparse, B
                          + 595 + 190   # POSIX, IO::Socket
                          + 3 * ($] > 5.009)
                          + 16 * ($] >= 5.009003)
@@ -157,6 +157,7 @@ my $testpkgs = {
                  formfeed end_av dowarn diehook defstash curstash
                  cstring comppadlist check_av cchar cast_I32 bootstrap
                  begin_av amagic_generation sub_generation address
+                 unitcheck_av
                  )],
     },
 

diff --git a/ext/B/t/optree_specials.t b/ext/B/t/optree_specials.t
index c666245..9d2a36e 100644 (file)
--- a/ext/B/t/optree_specials.t
+++ b/ext/B/t/optree_specials.t
@@ -27,7 +27,7 @@ BEGIN {
 use OptreeCheck;       # ALSO DOES @ARGV HANDLING !!!!!!
 use Config;
 
-plan tests => 7;
+plan tests => 8;
 
 require_ok("B::Concise");
 
@@ -38,7 +38,7 @@ my $out = runperl(
 
 #print "out:$out\n";
 
-my $src = q[our ($beg, $chk, $init, $end) = qq{'foo'}; BEGIN { $beg++ } CHECK { $chk++ } INIT { $init++ } END { $end++ }];
+my $src = q[our ($beg, $chk, $init, $end, $uc) = qq{'foo'}; BEGIN { $beg++ } CHECK { $chk++ } INIT { $init++ } END { $end++ } UNITCHECK {$uc++}];
 
 
 my @warnings_todo;
@@ -152,6 +152,28 @@ EOT_EOT
 # 2              <$> gvsv(*chk) s ->3
 EONT_EONT
 
+checkOptree ( name     => 'UNITCHECK',
+             bcopts    => 'UNITCHECK',
+             prog      => $src,
+             @open_todo,
+             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# UNITCHECK 1:
+# 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->4
+# 1        <;> nextstate(main 3 -e:4) v:{ ->2
+# 3        <1> postinc[t3] sK/1 ->4
+# -           <1> ex-rv2sv sKRM/1 ->3
+# 2              <#> gvsv[*uc] s ->3
+EOT_EOT
+# UNITCHECK 1:
+# 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->4
+# 1        <;> nextstate(main 3 -e:4) v:{ ->2
+# 3        <1> postinc[t2] sK/1 ->4
+# -           <1> ex-rv2sv sKRM/1 ->3
+# 2              <$> gvsv(*uc) s ->3
+EONT_EONT
+
 
 checkOptree ( name     => 'INIT',
              bcopts    => 'INIT',
@@ -177,8 +199,8 @@ EOT_EOT
 EONT_EONT
 
 
-checkOptree ( name     => 'all of BEGIN END INIT CHECK -exec',
-             bcopts    => [qw/ BEGIN END INIT CHECK -exec /],
+checkOptree ( name     => 'all of BEGIN END INIT CHECK UNITCHECK -exec',
+             bcopts    => [qw/ BEGIN END INIT CHECK UNITCHECK -exec /],
              prog      => $src,
              @warnings_todo,
              @open_todo,
@@ -215,6 +237,11 @@ checkOptree ( name => 'all of BEGIN END INIT CHECK -exec',
 # p  <#> gvsv[*chk] s
 # q  <1> postinc[t3] sK/1
 # r  <1> leavesub[1 ref] K/REFC,1
+# UNITCHECK 1:
+# s  <;> nextstate(main 6 -e:1) v:{
+# t  <#> gvsv[*uc] s
+# u  <1> postinc[t3] sK/1
+# v  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # BEGIN 1:
 # 1  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
@@ -248,6 +275,11 @@ EOT_EOT
 # p  <$> gvsv(*chk) s
 # q  <1> postinc[t2] sK/1
 # r  <1> leavesub[1 ref] K/REFC,1
+# UNITCHECK 1:
+# s  <;> nextstate(main 6 -e:1) v:{
+# t  <$> gvsv(*uc) s
+# u  <1> postinc[t2] sK/1
+# v  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT