Front page | perl.perl5.porters |
Postings from April 2001
[PATCH B::Deparse] fix easy bugs
Thread Previous
|
Thread Next
From:
Robin Houston
Date:
April 26, 2001 15:03
Subject:
[PATCH B::Deparse] fix easy bugs
Message ID:
20010426230333.A28657@puffinry.freeserve.co.uk
This patch fixes the easy bugs in B::Deparse. I think that the
majority of test failures now are due to one or more of the
hard problems which I mentioned in my last message.
Incidentally, there seems to be some kind of PerlIO issue which
makes O.pm occasionally dump core when passed the -qq switch. I
haven't tracked down the cause. As a temporary measure I've changed
-qq to -q in t/TEST, and added a 2>/dev/null redirect. I wanted
to avoid that for portability reasons, but it doesn't matter for
now. So if you want to try the tests, maybe do that.
The bugs fixed are:
* If pp_stub represents a statement, then produce "();"
rather than just "()".
* If a sub is prototyped but hasn't yet been declared,
call it with &foo() to avoid the warning.
* Infinite loops can have continue {} blocks, but for(;;)
cannot; so produce "while (1)" rather than "for (;;)"
for an infinite loop.
* The first numeric arg to chmod must be in octal with an
initial zero.
* Put statement labels after subroutines, not before.
I've also found another bug in the "slightly tricky" category,
which is that situations where an expression is used for a regex
are not handled correctly at all.
$foo =~ my_regex();
comes out as
$foo =~ /my_regex()/;
which really isn't right! No fix yet.
At this stage, all the base, comp, run and io tests pass.
The first test to fail is op/local test 35, with a scoping
issue.
.robin.
--- ext/B/B/Deparse.pm.sent3 Thu Apr 26 21:59:52 2001
+++ ext/B/B/Deparse.pm Thu Apr 26 22:39:47 2001
@@ -939,7 +939,10 @@
if (is_state $ops[$i]) {
$expr = $self->deparse($ops[$i], 0);
$i++;
- last if $i > $#ops;
+ if ($i > $#ops) {
+ push @exprs, $expr;
+ last;
+ }
}
if (!is_state $ops[$i] and $ops[$i+1] and !null($ops[$i+1]) and
$ops[$i+1]->name eq "leaveloop" and $self->{'expand'} < 3)
@@ -949,9 +952,9 @@
next;
}
$expr .= $self->deparse($ops[$i], 0);
+ $expr =~ s/;\n?\z//;
push @exprs, $expr if length $expr;
}
- for(@exprs[0..@exprs-1]) { s/;\n\z// }
return join(";\n", @exprs);
}
@@ -1121,9 +1124,9 @@
my($op, $cx) = @_;
$self->{'curcop'} = $op;
my @text;
- @text = $op->label . ": " if $op->label;
#push @text, "# ", $op->cop_seq, "\n";
push @text, $self->cop_subs($op);
+ push @text, $op->label . ": " if $op->label;
my $stash = $op->stashpv;
if ($stash ne $self->{'curstash'}) {
push @text, "package $stash;\n";
@@ -1196,7 +1199,16 @@
return $name;
}
-sub pp_stub { baseop(@_, "()") }
+sub pp_stub {
+ my $self = shift;
+ my($op, $cx, $name) = @_;
+ if ($cx) {
+ return "()";
+ }
+ else {
+ return "();";
+ }
+}
sub pp_wantarray { baseop(@_, "wantarray") }
sub pp_fork { baseop(@_, "fork") }
sub pp_wait { maybe_targmy(@_, \&baseop, "wait") }
@@ -1863,6 +1875,9 @@
else {
$first = $self->deparse($kid, 6);
}
+ if ($name eq "chmod" && $first =~ /^\d+$/) {
+ $first = sprintf("0%o", $first);
+ }
$first = "+$first" if not $parens and substr($first, 0, 1) eq "(";
push @exprs, $first;
$kid = $kid->sibling;
@@ -2156,7 +2171,7 @@
my $out_seq = $self->{'curcop'}->cop_seq;;
if ($kid->name eq "lineseq") { # bare or infinite loop
if (is_state $kid->last) { # infinite
- $head = "for (;;) "; # shorter than while (1)
+ $head = "while (1) "; # Can't use for(;;) if there's a continue
$cond = "";
} else {
$bare = 1;
@@ -2706,6 +2721,10 @@
# Doesn't matter how many prototypes there are, if
# they haven't happened yet!
my $declared = exists $self->{'subs_declared'}{$kid};
+ if (!$declared && defined($proto)) {
+ # Avoid "too early to check prototype" warning
+ ($amper, $proto) = ('&');
+ }
my $args;
if ($declared and defined $proto and not $amper) {
Thread Previous
|
Thread Next