From: Alexander Gough Date: Fri, 20 Oct 2006 02:05:20 +0000 (+0100) Subject: B:: changes for UNITCHECK blocks X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=676456c20d9092c3a5249acd38ce7d71e3ddeba8;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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, -C, C, or C will cause all of the corresponding -special blocks to be printed. +C, C, C, or C 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 --- 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 --- 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 --- 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