From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 20 May 2007 21:44:42 +0000 (-0700)
Subject: [perl #43010] [PATCH] Deparse, ''->(), ::(), sub :: {}, etc.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8b2d66400d0e016ebfcc9a22cd041309afd77ee0;p=p5sagit%2Fp5-mst-13.2.git

[perl #43010] [PATCH] Deparse, ''->(), ::(), sub :: {}, etc.
From: Father Chrysostomos (via RT) <perlbug-followup@perl.org>
Message-ID: <rt-3.6.HEAD-4015-1179722682-636.43010-75-0@perl.org>

p4raw-id: //depot/perl@31268
---

diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 0ef827c..770b78f 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -350,7 +350,7 @@ sub next_todo {
 		$name = "$self->{'curstash'}::$name" unless $name =~ /::/;
 		$self->{'curstash'} = $stash;
 	    }
-	    $name =~ s/^\Q$stash\E:://;
+	    $name =~ s/^\Q$stash\E::(?!\z|.*::)//;
 	}
         return "${p}${l}sub $name " . $self->deparse_sub($cv);
     }
@@ -469,7 +469,6 @@ sub stash_subs {
     }
     my %stash = svref_2object($stash)->ARRAY;
     while (my ($key, $val) = each %stash) {
-	next if $key eq 'main::';	# avoid infinite recursion
 	my $class = class($val);
 	if ($class eq "PV") {
 	    # Just a prototype. As an ugly but fairly effective way
@@ -503,7 +502,9 @@ sub stash_subs {
 		$self->todo($cv, 1);
 	    }
 	    if (class($val->HV) ne "SPECIAL" && $key =~ /::$/) {
-		$self->stash_subs($pack . $key);
+		$self->stash_subs($pack . $key)
+		    unless $pack eq '' && $key eq 'main::';
+		    # avoid infinite recursion
 	    }
 	}
     }
@@ -1236,8 +1237,12 @@ sub gv_name {
 Carp::confess() unless ref($gv) eq "B::GV";
     my $stash = $gv->STASH->NAME;
     my $name = $gv->SAFENAME;
-    if (($stash eq 'main' && $globalnames{$name})
-	or ($stash eq $self->{'curstash'} && !$globalnames{$name})
+    if ($stash eq 'main' && $name =~ /^::/) {
+	$stash = '::';
+    }
+    elsif (($stash eq 'main' && $globalnames{$name})
+	or ($stash eq $self->{'curstash'} && !$globalnames{$name}
+	    && ($stash eq 'main' || $name !~ /::/))
 	or $name =~ /^[^A-Za-z_:]/)
     {
 	$stash = "";
@@ -3241,6 +3246,13 @@ sub pp_entersub {
 	}
 	$simple = 1; # only calls of named functions can be prototyped
 	$kid = $self->deparse($kid, 24);
+	if (!$amper) {
+	    if ($kid eq 'main::') {
+		$kid = '::';
+	    } elsif ($kid !~ /^(?:\w|::)(?:[\w\d]|::(?!\z))*\z/) {
+		$kid = single_delim("q", "'", $kid) . '->';
+	    }
+	}
     } elsif (is_scalar ($kid->first) && $kid->first->name ne 'rv2cv') {
 	$amper = "&";
 	$kid = $self->deparse($kid, 24);
diff --git a/ext/B/t/deparse.t b/ext/B/t/deparse.t
index fe601b1..bf1e172 100644
--- a/ext/B/t/deparse.t
+++ b/ext/B/t/deparse.t
@@ -24,7 +24,7 @@ use warnings;
 use strict;
 use Config;
 
-print "1..43\n";
+print "1..47\n";
 
 use B::Deparse;
 my $deparse = B::Deparse->new() or print "not ";
@@ -334,3 +334,15 @@ do { my $x = 1; $x };
 my $f = sub {
     +{[]};
 } ;
+####
+# 38 (bug #43010)
+'!@$%'->();
+####
+# 39 (ibid.)
+::();
+####
+# 40 (ibid.)
+'::::'->();
+####
+# 41 (ibid.)
+&::::;