Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Towards making tree walk walk more fully #4

Merged
merged 6 commits into from

2 participants

@rocky

This goes a long way towards addressing a long-standing problem in Enbugger that it doesn't mark various COP lines as stoppable or breakpoint-able. This is seen for example in perl5db or Devel::Trepan when using Enbugger.

It also can be used to greatly simplify and extend B::CodeLines.

However there still is one omission that should be addressed. See FIXME inside newly-created test t/utils/40walk.t

@jbenjore jbenjore merged commit 62a70fc into jbenjore:master
@jbenjore
Owner
@rocky

This would be fantastic and would really help the other projects out.

In particular, I've already started redoing B::CodeLines to require B::Utils but it would have to be this newer (as yet unreleased) version in order to see benefit over what's there now.

I've been upset at a lingering problem in tree traversal which you can see in https://gist.github.com/3852403

Adding -d to Perl causes compilation to be slightly different which makes traversal via B::Concise or the patched B::Utils work.

I am at a loss as to why the traversal doesn't fully traverse. In B::CodeLines, a workaround would be to set the Perl debug flag, but I'd rather figure out why traversal isn't traversing.

Lastly, in the changes I used a revision number which I think may come out as a "testing" release. So you should look over and decide what revision number you want.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Oct 8, 2012
  1. LISTOPs don't seem to be the only OPs that one can iterate siblings o…

    rocky authored
    …ver. Start testing walkingoptree_simple.
  2. Untabify

    rocky authored
  3. Untabify and bump version

    rocky authored
  4. Indentation yet again.

    rocky authored
This page is out of date. Refresh to see the latest.
View
12 .gitignore
@@ -1,2 +1,12 @@
+*~
/.build
-/B-Utils-*
+/MYMETA.json
+/MYMETA.yml
+/Makefile
+/OP.c
+/OP.o
+/Utils.bs
+/Utils.c
+/Utils.o
+/blib
+pm_to_blib
View
39 lib/B/Utils.pm
@@ -29,11 +29,11 @@ B::Utils - Helper functions for op tree manipulation
=head1 VERSION
-0.21
+0.2101
=cut
-$VERSION = '0.21';
+$VERSION = '0.2101';
@@ -156,12 +156,10 @@ sub B::OP::kids {
return unless defined wantarray;
my @kids;
- if ( class($op) eq "LISTOP" ) {
- @kids = $op->first;
- push @kids, $kids[-1]->sibling while $kids[-1]->can('sibling');
- pop @kids
- if 'NULL' eq class( $kids[-1] );
-
+ if ( ref $op and $$op and $op->flags & OPf_KIDS ) {
+ for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
+ push @kids, $kid;
+ }
### Assert: $op->children == @kids
}
else {
@@ -318,7 +316,7 @@ Like C< $op-E<gt>next >, but not quite.
## for @kids;
##
## # For each child, check it for a match.
-## my $found;
+## my $found;
## $found = $search->($_) and return $found
## for @kids;
##
@@ -329,7 +327,7 @@ Like C< $op-E<gt>next >, but not quite.
##
## my $next = $target;
## while ( eval { $next = $next->next } ) {
-## my $result;
+## my $result;
## $result = $search->( $next )
## and return $result;
## }
@@ -599,7 +597,7 @@ sub walkoptree_simple {
sub _walkoptree_simple {
my ( $visited, $op, $callback, $data ) = @_;
- return if $visited->{$$op}++;
+ return if $visited->{$$op}++;
if ( ref $op and $op->isa("B::COP") ) {
$file = $op->file;
@@ -607,12 +605,21 @@ sub _walkoptree_simple {
}
$callback->( $op, $data );
- if ( ref $op
- and $$op
- and $op->flags & OPf_KIDS )
- {
+ return if $op->isa('B::NULL');
+ if ( $op->flags & OPf_KIDS ) {
+ # for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
+ # _walkoptree_simple( $visited, $kid, $callback, $data );
+ # }
_walkoptree_simple( $visited, $_, $callback, $data ) for $op->kids;
}
+ if ( $op->isa('B::PMOP') ) {
+ my $maybe_root = $op->pmreplroot;
+ if (ref($maybe_root) and $maybe_root->isa("B::OP")) {
+ # It really is the root of the replacement, not something
+ # else stored here for lack of space elsewhere
+ _walkoptree_simple( $visited, $maybe_root, $callback, $data );
+ }
+ }
return;
@@ -637,7 +644,7 @@ sub walkoptree_filtered {
}
sub _walkoptree_filtered {
- my ( $visited, $op, $filter, $callback, $data ) = @_;
+ my ( $visited, $op, $filter, $callback, $data ) = @_;
if ( $op->isa("B::COP") ) {
$file = $op->file;
View
2  lib/B/Utils/OP.pm
@@ -8,7 +8,7 @@ use B::Utils ();
our @ISA = 'Exporter';
require Exporter;
-our $VERSION = '0.21';
+our $VERSION = '0.2101';
our @EXPORT = qw(parent_op return_op);
View
23 t/utils/30parent.t
@@ -1,3 +1,5 @@
+use B qw( OPf_KIDS );
+my @empty_array = ();
test_data() for @empty_array;
{
@@ -29,10 +31,21 @@ use B::Utils 'walkoptree_simple';
# );
# B::Concise::compile("test_data")->();
+# FIXME: Consider moving this into B::Utils. But consider warning about
+# adding to B::OPS and B::Concise.
+sub has_branch($)
+{
+ my $op = shift;
+ return ref($op) and $$op and ($op->flags & OPf_KIDS);
+}
+
# Set the # of tests to run and make a table of parents
my $tests = 0;
my $root = svref_2object( \&test_data )->ROOT;
-walkoptree_simple( $root, sub { ++$tests } );
+walkoptree_simple( $root, sub {
+ my $op = shift;
+ $tests++ if has_branch($op)}
+ );
plan( tests => ( $tests * 2 ) - 1 );
walkoptree_simple(
@@ -47,16 +60,16 @@ walkoptree_simple(
else {
ok( $parent, $op->stringify . " has a parent" );
-
+
my $correct_parent;
for ( $parent ? $parent->kids : () ) {
if ( $$_ == $$op ) {
- $correct_parent = 1;
+ $correct_parent = $_;
last;
}
}
-
- ok( $correct_parent, $op->stringify . " has the *right* parent" );
+ is( $$correct_parent, $$op,
+ $op->stringify . " has the *right* parent " . $parent);
}
}
);
View
38 t/utils/40walk.t
@@ -1 +1,37 @@
-use Test::More skip_all => "No tests written yet.";
+#!perl
+use Test::More;
+use lib '../../lib';
+use lib '../../blib/arch/auto/B/Utils';
+use B qw(class);
+use B::Utils qw( all_roots walkoptree_simple);
+
+my @lines = ();
+my $callback = sub
+{
+ my $op = shift;
+ if ('COP' eq B::class($op) and $op->file eq __FILE__) {
+ push @lines, $op->line;
+ }
+};
+
+foreach my $op (values all_roots) {
+ walkoptree_simple( $op, $callback );
+}
+is_deeply(\@lines,
+ [8, 15, 17, 18, 20, 29,
+ # 30, # See FIXME: below
+ 32, 35,
+ # 37,
+ ],
+ 'walkoptree_simple lines of ' . __FILE__);
+
+# For testing following if/else in code.
+if (@lines) {
+ ok(1); # FIXME: This line isn't coming out.
+} else {
+ ok(0);
+}
+
+done_testing();
+__END__
+diag join(', ', @lines), "\n";
Something went wrong with that request. Please try again.