Make B::Deparse qualify sub calls named after keywords
authorFather Chrysostomos <sprout@cpan.org>
Sun, 5 Oct 2014 20:32:20 +0000 (13:32 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 5 Oct 2014 20:32:20 +0000 (13:32 -0700)
While B::Deparse was correctly applying CORE:: as necessary to dis-
ambiguate between keywords and custom subroutines, it was not doing
likewise for subroutines whose names were keywords.  main::foo()
should be deparsed as main::foo() if ‘foo’ is a keyword.

lib/B/Deparse-core.t
lib/B/Deparse.pm
lib/B/Deparse.t

index 297717c..2446622 100644 (file)
@@ -132,6 +132,10 @@ sub do_infix_keyword {
     testit $keyword, "(\$a CORE::$keyword \$b)", $exp;
     testit $keyword, "(\$a $keyword \$b)", $exp;
     if (!$strong) {
+       # B::Deparse fully qualifies any sub whose name is a keyword,
+       # imported or not, since the importedness may not be reproduced by
+       # the deparsed code.  x is special.
+       $keyword =~ s/^(?!x\z)/test::/;
        testit $keyword, "$keyword(\$a, \$b)", "$keyword(\$a, \$b);";
     }
 }
@@ -157,7 +161,9 @@ sub do_std_keyword {
            $args = ((!$core && !$strong) || $parens)
                        ? "($args)"
                        :  @args ? " $args" : "";
-           push @code, (($core && !($do_exp && $strong)) ? "CORE::" : "")
+           push @code, (($core && !($do_exp && $strong))
+                          ? "CORE::"
+                          : $do_exp && !$core && !$strong ? "test::" : "")
                                                        . "$keyword$args;";
        }
        testit $keyword, @code; # code[0]: to run; code[1]: expected
@@ -210,7 +216,7 @@ testit delete   => 'delete $h{\'foo\'};',       'delete $h{\'foo\'};';
 # do is listed as strong, but only do { block } is strong;
 # do $file is weak,  so test it separately here
 testit do       => 'CORE::do $a;';
-testit do       => 'do $a;',                     'do($a);';
+testit do       => 'do $a;',                    'test::do($a);';
 testit do       => 'CORE::do { 1 }',
                   "do {\n        1\n    };";
 testit do       => 'do { 1 };',
index 8d99acc..424e248 100644 (file)
@@ -1870,20 +1870,23 @@ my %strong_proto_keywords = map { $_ => 1 } qw(
     undef
 );
 
-sub keyword {
-    my $self = shift;
-    my $name = shift;
-    return $name if $name =~ /^CORE::/; # just in case
-    if (exists $feature_keywords{$name}) {
+sub feature_enabled {
+       my($self,$name) = @_;
        my $hh;
        my $hints = $self->{hints} & $feature::hint_mask;
        if ($hints && $hints != $feature::hint_mask) {
            $hh = _features_from_bundle($hints);
        }
        elsif ($hints) { $hh = $self->{'hinthash'} }
-       return "CORE::$name"
-        if !$hh
-        || !$hh->{"feature_$feature_keywords{$name}"}
+       return $hh && $hh->{"feature_$feature_keywords{$name}"}
+}
+
+sub keyword {
+    my $self = shift;
+    my $name = shift;
+    return $name if $name =~ /^CORE::/; # just in case
+    if (exists $feature_keywords{$name}) {
+       return "CORE::$name" if not $self->feature_enabled($name);
     }
     if ($strong_proto_keywords{$name}
         || ($name !~ /^(?:chom?p|do|exec|glob|s(?:elect|ystem))\z/
@@ -3882,8 +3885,24 @@ sub pp_entersub {
        if (!$amper) {
            if ($kid eq 'main::') {
                $kid = '::';
-           } elsif ($kid !~ /^(?:\w|::)(?:[\w\d]|::(?!\z))*\z/) {
+           }
+           else {
+             if ($kid !~ /::/ && $kid ne 'x') {
+               # Fully qualify any sub name that is also a keyword.  While
+               # we could check the import flag, we cannot guarantee that
+               # the code deparsed so far would set that flag, so we qual-
+               # ify the names regardless of importation.
+               my $fq;
+               if (exists $feature_keywords{$kid}) {
+                   $fq++ if $self->feature_enabled($kid);
+               } elsif (eval { () = prototype "CORE::$kid"; 1 }) {
+                   $fq++
+               }
+               $fq and substr $kid, 0, 0, = $self->{'curstash'}.'::';
+             }
+             if ($kid !~ /^(?:\w|::)(?:[\w\d]|::(?!\z))*\z/) {
                $kid = single_delim("q", "'", $kid) . '->';
+             }
            }
        }
     } elsif (is_scalar ($kid->first) && $kid->first->name ne 'rv2cv') {
index ffc2a16..75a5fc2 100644 (file)
@@ -1506,3 +1506,10 @@ my(@array, %hash, @a, @b, %c, %d);
 () = \(@Foo::array);
 () = \(%Foo::hash);
 () = \(@Foo::a, (@Foo::b), (%Foo::c), %Foo::d);
+####
+# subs synonymous with keywords
+main::our();
+main::pop();
+state();
+use feature 'state';
+main::state();