This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
lib/B/Deparse.pm: refactor a hash slightly
authorKarl Williamson <khw@cpan.org>
Wed, 31 Dec 2014 03:50:39 +0000 (20:50 -0700)
committerKarl Williamson <khw@cpan.org>
Wed, 31 Dec 2014 04:18:48 +0000 (21:18 -0700)
Two of the three uses of this hash want the result to be of the form
"\cX".  The other wants "^X".  This changes the hash to be the common
substring to all three, and then the proper prefix is added to each.

lib/B/Deparse.pm

index 7ae8ccc..c496c8a 100644 (file)
@@ -1722,37 +1722,37 @@ sub stash_variable {
 
 my %unctrl = # portable to EBCDIC
     (
-     "\c@" => '\c@',   # unused
-     "\cA" => '\cA',
-     "\cB" => '\cB',
-     "\cC" => '\cC',
-     "\cD" => '\cD',
-     "\cE" => '\cE',
-     "\cF" => '\cF',
-     "\cG" => '\cG',
-     "\cH" => '\cH',
-     "\cI" => '\cI',
-     "\cJ" => '\cJ',
-     "\cK" => '\cK',
-     "\cL" => '\cL',
-     "\cM" => '\cM',
-     "\cN" => '\cN',
-     "\cO" => '\cO',
-     "\cP" => '\cP',
-     "\cQ" => '\cQ',
-     "\cR" => '\cR',
-     "\cS" => '\cS',
-     "\cT" => '\cT',
-     "\cU" => '\cU',
-     "\cV" => '\cV',
-     "\cW" => '\cW',
-     "\cX" => '\cX',
-     "\cY" => '\cY',
-     "\cZ" => '\cZ',
-     "\c[" => '\c[',   # unused
-     "\c\\" => '\c\\', # unused
-     "\c]" => '\c]',   # unused
-     "\c_" => '\c_',   # unused
+     "\c@" => '@',     # unused
+     "\cA" => 'A',
+     "\cB" => 'B',
+     "\cC" => 'C',
+     "\cD" => 'D',
+     "\cE" => 'E',
+     "\cF" => 'F',
+     "\cG" => 'G',
+     "\cH" => 'H',
+     "\cI" => 'I',
+     "\cJ" => 'J',
+     "\cK" => 'K',
+     "\cL" => 'L',
+     "\cM" => 'M',
+     "\cN" => 'N',
+     "\cO" => 'O',
+     "\cP" => 'P',
+     "\cQ" => 'Q',
+     "\cR" => 'R',
+     "\cS" => 'S',
+     "\cT" => 'T',
+     "\cU" => 'U',
+     "\cV" => 'V',
+     "\cW" => 'W',
+     "\cX" => 'X',
+     "\cY" => 'Y',
+     "\cZ" => 'Z',
+     "\c[" => '[',     # unused
+     "\c\\" => '\\',   # unused
+     "\c]" => ']',     # unused
+     "\c_" => '_',     # unused
     );
 
 # Return just the name, without the prefix.  It may be returned as a quoted
@@ -1762,9 +1762,7 @@ sub stash_variable_name {
     my $name = $self->gv_name($gv, 1);
     $name = $self->maybe_qualify($prefix,$name);
     if ($name =~ /^(?:\S|(?!\d)[\ca-\cz]?(?:\w|::)*|\d+)\z/) {
-       if ($name =~ s/^([\ca-\cz])/$unctrl{$1}/e) {
-            $name =~ s/\\c/^/g;
-        }
+       $name =~ s/^([\ca-\cz])/'^' . $unctrl{$1}/e;
        $name =~ /^(\^..|{)/ and $name = "{$name}";
        return $name, 0; # not quoted
     }
@@ -4604,7 +4602,7 @@ sub escape_str { # ASCII, UTF8
     $str =~ s/\e/\\e/g;
     $str =~ s/\f/\\f/g;
     $str =~ s/\r/\\r/g;
-    $str =~ s/([\cA-\cZ])/$unctrl{$1}/ge;
+    $str =~ s/([\cA-\cZ])/'\\c' . $unctrl{$1}/ge;
     $str =~ s/([[:^print:]])/sprintf("\\%03o", ord($1))/age;
     return $str;
 }
@@ -5019,7 +5017,7 @@ sub pchr { # ASCII
     } elsif ($n == ord "\r") {
        return '\\r';
     } elsif ($n >= ord("\cA") and $n <= ord("\cZ")) {
-       return unctrl{chr $n};
+       return '\\c' . unctrl{chr $n};
     } else {
 #      return '\x' . sprintf("%02x", $n);
        return '\\' . sprintf("%03o", $n);