[perl #117081] Deparse foreach my $lexical correctly under -p

The lexical topic in foreach is not allowed to have parentheses around
it, but B::Deparse was putting parentheses there when the -p option
was specified.

2 files changed, 20 insertions, 6 deletions

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index 9133c40615..e50ea066d4 100644
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -1226,12 +1226,12 @@ sub padname_sv {
 
 sub maybe_my {
     my $self = shift;
-    my($op, $cx, $text) = @_;
+    my($op, $cx, $text, $forbid_parens) = @_;
     if ($op->private & OPpLVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
 	my $my = $op->private & OPpPAD_STATE
 	    ? $self->keyword("state")
 	    : "my";
-	if (want_scalar($op)) {
+	if ($forbid_parens || want_scalar($op)) {
 	    return "$my $text";
 	} else {
 	    return $self->maybe_parens_func($my, $text, $cx, 16);
@@ -3111,7 +3111,7 @@ sub loop_common {
 		# thread special var, under 5005threads
 		$var = $self->pp_threadsv($enter, 1);
 	    } else { # regular my() variable
-		$var = $self->pp_padsv($enter, 1);
+		$var = $self->pp_padsv($enter, 1, 1);
 	    }
 	} elsif ($var->name eq "rv2gv") {
 	    $var = $self->pp_rv2sv($var, 1);
@@ -3267,8 +3267,9 @@ sub padany {
 
 sub pp_padsv {
     my $self = shift;
-    my($op, $cx) = @_;
-    return $self->maybe_my($op, $cx, $self->padname($op->targ));
+    my($op, $cx, $forbid_parens) = @_;
+    return $self->maybe_my($op, $cx, $self->padname($op->targ),
+			   $forbid_parens);
 }
 
 sub pp_padav { pp_padsv(@_) }
diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index 7d4f9fe4f5..eb87bfd374 100644
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -18,6 +18,7 @@ my $tests = 18; # not counting those in the __DATA__ section
 use B::Deparse;
 my $deparse = B::Deparse->new();
 isa_ok($deparse, 'B::Deparse', 'instantiate a B::Deparse object');
+my %deparse;
 
 $/ = "\n####\n";
 while (<DATA>) {
@@ -26,7 +27,7 @@ while (<DATA>) {
     # This code is pinched from the t/lib/common.pl for TODO.
     # It's not clear how to avoid duplication
     my %meta = (context => '');
-    foreach my $what (qw(skip todo context)) {
+    foreach my $what (qw(skip todo context options)) {
 	s/^#\s*\U$what\E\s*(.*)\n//m and $meta{$what} = $1;
 	# If the SKIP reason starts ? then it's taken as a code snippet to
 	# evaluate. This provides the flexibility to have conditional SKIPs
@@ -57,6 +58,12 @@ while (<DATA>) {
 	($input, $expected) = ($_, $_);
     }
 
+    # parse options if necessary
+    my $deparse = $meta{options}
+	? $deparse{$meta{options}} ||=
+	    new B::Deparse split /,/, $meta{options}
+	: $deparse;
+
     my $coderef = eval "$meta{context};\n" . <<'EOC' . "sub {$input}";
 # Tell B::Deparse about our ambient pragmas
 my ($hint_bits, $warning_bits, $hinthash);
@@ -362,6 +369,12 @@ foreach my $i (1, 2) {
     my $z = 1;
 }
 ####
+# OPTIONS -p
+# foreach with my under -p
+foreach my $i (1) {
+    die;
+}
+####
 # foreach
 my $i;
 foreach $i (1, 2) {