This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deparse require vstring without parens
authorFather Chrysostomos <sprout@cpan.org>
Sat, 13 Dec 2014 14:34:48 +0000 (06:34 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 13 Dec 2014 15:28:35 +0000 (07:28 -0800)
require(v5.16) does not work.  I broke this by adding the parens in
917a8f4f52.

lib/B/Deparse.pm
lib/B/Deparse.t

index 9a8ad2b..0510623 100644 (file)
@@ -2421,23 +2421,30 @@ sub pp_require {
     my $self = shift;
     my($op, $cx) = @_;
     my $opname = $op->flags & OPf_SPECIAL ? 'CORE::require' : 'require';
-    if (class($op) eq "UNOP" and $op->first->name eq "const"
-       and $op->first->private & OPpCONST_BARE)
-    {
-       my $name = $self->const_sv($op->first)->PV;
-       $name =~ s[/][::]g;
-       $name =~ s/\.pm//g;
-       return $self->maybe_parens("$opname $name", $cx, 16);
-    } else {   
-       $self->unop(
+    my $kid = $op->first;
+    if ($kid->name eq 'const') {
+       my $priv = $kid->private;
+       my $sv = $self->const_sv($kid);
+       my $arg;
+       if ($priv & OPpCONST_BARE) {
+           $arg = $sv->PV;
+           $arg =~ s[/][::]g;
+           $arg =~ s/\.pm//g;
+       } elsif ($priv & OPpCONST_NOVER) {
+           $opname = $self->keyword('no');
+           $arg = $self->const($sv, 16);
+       } elsif ((my $tmp = $self->const($sv, 16)) =~ /^v/) {
+           $arg = $tmp;
+       }
+       if ($arg) {
+           return $self->maybe_parens("$opname $arg", $cx, 16);
+       }
+    }
+    $self->unop(
            $op, $cx,
-           $op->first->name eq 'const'
-            && $op->first->private & OPpCONST_NOVER
-                ? "no"
-                : $opname,
+           $opname,
            1, # llafr does not apply
-       );
-    }
+    );
 }
 
 sub pp_scalar {
index 8d52e90..5254db4 100644 (file)
@@ -1568,6 +1568,9 @@ last (foo());
 next (foo());
 redo (foo());
 ####
+# require vstring
+require v5.16;
+####
 # [perl #97476] not() *does* follow the llafr
 $_ = ($a xor not +($1 || 2) ** 2);
 ####