develooper 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


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About