diff options
| author | Robin Houston <robin@cpan.org> | 2001-04-05 15:27:38 +0100 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-04-05 18:23:03 +0000 |
| commit | 002b978b598c42691928a27566ef8edaaeaa8696 (patch) | |
| tree | 5b979d0e4cac80d0484d840f333bf5e6ff0d8841 | |
| parent | 32b4ad3c69185f4ce7cd382edebd968b87bc3e6f (diff) | |
| download | perl-002b978b598c42691928a27566ef8edaaeaa8696.tar.gz | |
print control-character vars readably
Message-ID: <20010405142738.A15855@puffinry.freeserve.co.uk>
Needs EBCDICification.
p4raw-id: //depot/perl@9564
| -rw-r--r-- | ext/B/B.pm | 21 | ||||
| -rw-r--r-- | ext/B/B/Concise.pm | 4 | ||||
| -rw-r--r-- | ext/B/B/Debug.pm | 4 | ||||
| -rw-r--r-- | ext/B/B/Terse.pm | 2 |
4 files changed, 26 insertions, 5 deletions
diff --git a/ext/B/B.pm b/ext/B/B.pm index ad8699f803..6c2f013da6 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -60,6 +60,12 @@ use strict; package B::OBJECT; } +sub B::GV::SAFENAME { + my $name = (shift())->NAME; + $name =~ s/^([\cA-\cZ])/"^".chr(64 + ord($1))/e; + return $name; +} + my $debug; my $op_count = 0; my @parents = (); @@ -449,6 +455,21 @@ This method returns TRUE if the GP field of the GV is NULL. =item NAME +=item SAFENAME + +This method returns the name of the glob, but if the first +character of the name is a control character, then it converts +it to ^X first, so that *^G would return "^G" rather than "\cG". + +It's useful if you want to print out the name of a variable. +If you restrict yourself to globs which exist at compile-time +then the result ought to be unambiguous, because code like +C<${"^G"} = 1> is compiled as two ops - a constant string and +a dereference (rv2gv) - so that the glob is created at runtime. + +If you're working with globs at runtime, and need to disambiguate +*^G from *{"^G"}, then you should use the raw NAME method. + =item STASH =item SV diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 2dd43a932a..cb352ebf1c 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -385,8 +385,8 @@ sub concise_op { } else { $stash = $stash . "::"; } - $h{arg} = "(*$stash" . $gv->NAME . ")"; - $h{svval} = "*$stash" . $gv->NAME; + $h{arg} = "(*$stash" . $gv->SAFENAME . ")"; + $h{svval} = "*$stash" . $gv->SAFENAME; } else { while (class($sv) eq "RV") { $h{svval} .= "\\"; diff --git a/ext/B/B/Debug.pm b/ext/B/B/Debug.pm index 71540a1bc7..049195b423 100644 --- a/ext/B/B/Debug.pm +++ b/ext/B/B/Debug.pm @@ -218,14 +218,14 @@ EOT sub B::GV::debug { my ($gv) = @_; if ($done_gv{$$gv}++) { - printf "GV %s::%s\n", $gv->STASH->NAME, $gv->NAME; + printf "GV %s::%s\n", $gv->STASH->NAME, $gv->SAFENAME; return; } my ($sv) = $gv->SV; my ($av) = $gv->AV; my ($cv) = $gv->CV; $gv->B::SV::debug; - printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILE, $gv->GvFLAGS; + printf <<'EOT', $gv->SAFENAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILE, $gv->GvFLAGS; NAME %s STASH %s (0x%x) SV 0x%x diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm index 8f669b463f..bf4ef4b386 100644 --- a/ext/B/B/Terse.pm +++ b/ext/B/B/Terse.pm @@ -102,7 +102,7 @@ sub B::GV::terse { $stash = $stash . "::"; } print indent($level); - printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->NAME; + printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME; } sub B::IV::terse { |