# curcv:
# CV for current sub (or main program) being deparsed
#
+# curcvlex:
+# Cached hash of lexical variables for curcv: keys are names,
+# each value is an array of pairs, indicating the cop_seq of scopes
+# in which a var of that name is valid.
+#
# curcop:
# COP for statement being deparsed
#
$self->{'subs_declared'}{$name} = 1;
if ($name eq "BEGIN") {
my $use_dec = $self->begin_is_use($cv);
- return $use_dec if defined ($use_dec);
+ if (defined ($use_dec)) {
+ return () if 0 == length($use_dec);
+ return $use_dec;
+ }
}
return "sub $name " . $self->deparse_sub($cv);
}
# Certain pragmas are dealt with using hint bits,
# so we ignore them here
if ($module eq 'strict' || $module eq 'integer'
- || $module eq 'bytes') {
+ || $module eq 'bytes' || $module eq 'warnings') {
return "";
}
if (class(my $cv = $val->CV) ne "SPECIAL") {
next unless $cv->FILE eq $0 || $self->{'files'}{$cv->FILE};
next if $self->{'subs_done'}{$$val}++;
- $self->todo($val->CV, 0);
- $self->walk_sub($val->CV);
+ next if ${$cv->GV} != $$val;
+ $self->todo($cv, 0);
+ $self->walk_sub($cv);
}
if (class($val->FORM) ne "SPECIAL") {
next if $self->{'forms_done'}{$$val}++;
}
$self->stash_subs();
$self->{'curcv'} = main_cv;
+ $self->{'curcvlex'} = undef;
$self->walk_sub(main_cv, main_start);
print $self->print_protos;
@{$self->{'subs_todo'}} =
}
local($self->{'curcv'}) = $cv;
+ local($self->{'curcvlex'});
local(@$self{qw'curstash warnings hints'})
= @$self{qw'curstash warnings hints'};
if (not null $cv->ROOT) {
my $form = shift;
my @text;
local($self->{'curcv'}) = $form;
+ local($self->{'curcvlex'});
local(@$self{qw'curstash warnings hints'})
= @$self{'curstash warnings hints'};
my $op = $form->ROOT;
return $stash . $name;
}
+# Return the name to use for a stash variable.
+# If a lexical with the same name is in scope, it may need to be
+# fully-qualified.
+sub stash_variable {
+ my ($self, $prefix, $name) = @_;
+
+ return "$prefix$name" if $name =~ /::/;
+
+ unless ($prefix eq '$' || $prefix eq '@' ||
+ $prefix eq '%' || $prefix eq '$#') {
+ return "$prefix$name";
+ }
+
+ my $v = ($prefix eq '$#' ? '@' : $prefix) . $name;
+ return $prefix .$self->{'curstash'}.'::'. $name if $self->lex_in_scope($v);
+ return "$prefix$name";
+}
+
+sub lex_in_scope {
+ my ($self, $name) = @_;
+ $self->populate_curcvlex() if !defined $self->{'curcvlex'};
+
+ my $seq = $self->{'curcop'}->cop_seq;
+ return 0 if !exists $self->{'curcvlex'}{$name};
+ for my $a (@{$self->{'curcvlex'}{$name}}) {
+ my ($st, $en) = @$a;
+ return 1 if $seq > $st && $seq <= $en;
+ }
+ return 0;
+}
+
+sub populate_curcvlex {
+ my $self = shift;
+ for (my $cv = $self->{'curcv'}; $$cv; $cv = $cv->OUTSIDE) {
+ my @padlist = $cv->PADLIST->ARRAY;
+ my @ns = $padlist[0]->ARRAY;
+
+ for (my $i=0; $i<@ns; ++$i) {
+ next if class($ns[$i]) eq "SPECIAL";
+ if (class($ns[$i]) eq "PV") {
+ # Probably that pesky lexical @_
+ next;
+ }
+ my $name = $ns[$i]->PVX;
+ my $seq_st = $ns[$i]->NVX;
+ my $seq_en = int($ns[$i]->IVX);
+
+ push @{$self->{'curcvlex'}{$name}}, [$seq_st, $seq_en];
+ }
+ }
+}
+
# Recurses down the tree, looking for a COP
sub find_cop {
my ($self, $op) = @_;
my $self = shift;
my($op, $cx) = @_;
my $gv = $self->gv_or_padgv($op);
- return $self->maybe_local($op, $cx, "\$" . $self->gv_name($gv));
+ return $self->maybe_local($op, $cx, $self->stash_variable("\$",
+ $self->gv_name($gv)));
}
sub pp_gv {
my($op, $cx, $type) = @_;
my $kid = $op->first;
my $str = $self->deparse($kid, 0);
- return $type . (is_scalar($kid) ? $str : "{$str}");
+ return $self->stash_variable($type, $str) if is_scalar($kid);
+ return $type ."{$str}";
}
sub pp_rv2sv { maybe_local(@_, rv2x(@_, "\$")) }