1#!./perl 2 3BEGIN { 4 unshift @INC, 't'; 5 require Config; 6 if (($Config::Config{'extensions'} !~ /\bB\b/) ){ 7 print "1..0 # Skip -- Perl configured without B module\n"; 8 exit 0; 9 } 10} 11 12use warnings; 13use strict; 14use Test::More; 15 16BEGIN { use_ok( 'B' ); } 17 18# Somewhat minimal tests. 19 20my %seen; 21 22sub B::OP::pie { 23 my $self = shift; 24 return ++$seen{$self->name}; 25} 26 27my %debug; 28sub B::OP::walkoptree_debug { 29 my $self = shift; 30 return ++$debug{$self->name}; 31} 32 33my $victim = sub { 34 # This gives us a substcont, which gets to the second recursive call 35 # point (in the if statement in the XS code) 36 $_[0] =~ s/(a)/ $1/; 37 # PMOP_pmreplroot(cPMOPo) is NULL for this 38 $_[0] =~ s/(b)//; 39 # This gives an OP_SPLIT 40 split /c/; 41}; 42 43is (B::walkoptree_debug, 0, 'walkoptree_debug() is 0'); 44B::walkoptree(B::svref_2object($victim)->ROOT, "pie"); 45foreach (qw(substcont split leavesub)) { 46 is ($seen{$_}, 1, "Our victim had a $_ OP"); 47} 48is_deeply ([keys %debug], [], 'walkoptree_debug was not called'); 49 50B::walkoptree_debug(2); 51is (B::walkoptree_debug(), 1, 'walkoptree_debug() is 1'); 52B::walkoptree_debug(0); 53is (B::walkoptree_debug(), 0, 'walkoptree_debug() is 0'); 54B::walkoptree_debug(1); 55is (B::walkoptree_debug(), 1, 'walkoptree_debug() is 1 again'); 56%seen = (); 57 58B::walkoptree(B::svref_2object($victim)->ROOT, "pie"); 59foreach (qw(substcont split leavesub)) { 60 is ($seen{$_}, 1, "Our victim had a $_ OP"); 61} 62is_deeply (\%debug, \%seen, 'walkoptree_debug was called correctly'); 63 64my %seen2; 65 66# Now try to exercise the code in walkoptree that decides that it can't re-use 67# the object and reference. 68sub B::OP::fiddle { 69 my $name = $_[0]->name; 70 ++$seen2{$name}; 71 if ($name =~ /^s/) { 72 # Take another reference to the reference 73 push @::junk, \$_[0]; 74 } elsif ($name =~ /^p/) { 75 # Take another reference to the object 76 push @::junk, \${$_[0]}; 77 } elsif ($name =~ /^l/) { 78 undef $_[0]; 79 } elsif ($name =~ /g/) { 80 ${$_[0]} = "Muhahahahaha!"; 81 } elsif ($name =~ /^c/) { 82 bless \$_[0]; 83 } 84} 85 86B::walkoptree(B::svref_2object($victim)->ROOT, "fiddle"); 87is_deeply (\%seen2, \%seen, 'everything still seen'); 88 89done_testing(); 90