fix `l $var` where $var is a lexical variable

As with `i $obj` the DB::Obj in the call stack prevented DB::eval
from compiling/executing in the context of the debugged code.

1 files changed, 276 insertions, 273 deletions

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index b647d24fb8..065fa85ba1 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2543,6 +2543,280 @@ sub _DB__handle_i_command {
     next CMD;
 }
 
+=head3 C<cmd_l> - list lines (command)
+
+Most of the command is taken up with transforming all the different line
+specification syntaxes into 'start-stop'. After that is done, the command
+runs a loop over C<@dbline> for the specified range of lines. It handles
+the printing of each line and any markers (C<==E<gt>> for current line,
+C<b> for break on this line, C<a> for action on this line, C<:> for this
+line breakable).
+
+We save the last line listed in the C<$start> global for further listing
+later.
+
+=cut
+
+sub _min {
+    my $min = shift;
+    foreach my $v (@_) {
+        if ($min > $v) {
+            $min = $v;
+        }
+    }
+    return $min;
+}
+
+sub _max {
+    my $max = shift;
+    foreach my $v (@_) {
+        if ($max < $v) {
+            $max = $v;
+        }
+    }
+    return $max;
+}
+
+sub _minify_to_max {
+    my $ref = shift;
+
+    $$ref = _min($$ref, $max);
+
+    return;
+}
+
+sub _cmd_l_handle_var_name {
+    my $var_name = shift;
+
+    $evalarg = $var_name;
+
+    my ($s) = DB::eval();
+
+    # Ooops. Bad scalar.
+    if ($@) {
+        print {$OUT} "Error: $@\n";
+        next CMD;
+    }
+
+    # Good scalar. If it's a reference, find what it points to.
+    $s = CvGV_name($s);
+    print {$OUT} "Interpreted as: $1 $s\n";
+    $line = "$1 $s";
+
+    # Call self recursively to really do the command.
+    return _cmd_l_main( $s );
+}
+
+sub _cmd_l_handle_subname {
+
+    my $s = $subname;
+
+    # De-Perl4.
+    $subname =~ s/\'/::/;
+
+    # Put it in this package unless it starts with ::.
+    $subname = $package . "::" . $subname unless $subname =~ /::/;
+
+    # Put it in CORE::GLOBAL if t doesn't start with :: and
+    # it doesn't live in this package and it lives in CORE::GLOBAL.
+    $subname = "CORE::GLOBAL::$s"
+    if not defined &$subname
+        and $s !~ /::/
+        and defined &{"CORE::GLOBAL::$s"};
+
+    # Put leading '::' names into 'main::'.
+    $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
+
+    # Get name:start-stop from find_sub, and break this up at
+    # colons.
+    my @pieces = split( /:/, find_sub($subname) || $sub{$subname} );
+
+    # Pull off start-stop.
+    my $subrange = pop @pieces;
+
+    # If the name contained colons, the split broke it up.
+    # Put it back together.
+    $file = join( ':', @pieces );
+
+    # If we're not in that file, switch over to it.
+    if ( $file ne $filename ) {
+        if (! $slave_editor) {
+            print {$OUT} "Switching to file '$file'.\n";
+        }
+
+        # Switch debugger's magic structures.
+        *dbline   = $main::{ '_<' . $file };
+        $max      = $#dbline;
+        $filename = $file;
+    } ## end if ($file ne $filename)
+
+    # Subrange is 'start-stop'. If this is less than a window full,
+    # swap it to 'start+', which will list a window from the start point.
+    if ($subrange) {
+        if ( eval($subrange) < -$window ) {
+            $subrange =~ s/-.*/+/;
+        }
+
+        # Call self recursively to list the range.
+        return _cmd_l_main( $subrange );
+    } ## end if ($subrange)
+
+    # Couldn't find it.
+    else {
+        print {$OUT} "Subroutine $subname not found.\n";
+        return;
+    }
+}
+
+sub _cmd_l_empty {
+    # Compute new range to list.
+    $incr = $window - 1;
+
+    # Recurse to do it.
+    return _cmd_l_main( $start . '-' . ( $start + $incr ) );
+}
+
+sub _cmd_l_plus {
+    my ($new_start, $new_incr) = @_;
+
+    # Don't reset start for 'l +nnn'.
+    $start = $new_start if $new_start;
+
+    # Increment for list. Use window size if not specified.
+    # (Allows 'l +' to work.)
+    $incr = $new_incr || ($window - 1);
+
+    # Create a line range we'll understand, and recurse to do it.
+    return _cmd_l_main( $start . '-' . ( $start + $incr ) );
+}
+
+sub _cmd_l_calc_initial_end_and_i {
+    my ($spec, $start_match, $end_match) = @_;
+
+    # Determine end point; use end of file if not specified.
+    my $end = ( !defined $start_match ) ? $max :
+    ( $end_match ? $end_match : $start_match );
+
+    # Go on to the end, and then stop.
+    _minify_to_max(\$end);
+
+    # Determine start line.
+    my $i = $start_match;
+
+    if ($i eq '.') {
+        $i = $spec;
+    }
+
+    $i = _max($i, 1);
+
+    $incr = $end - $i;
+
+    return ($end, $i);
+}
+
+sub _cmd_l_range {
+    my ($spec, $current_line, $start_match, $end_match) = @_;
+
+    my ($end, $i) =
+        _cmd_l_calc_initial_end_and_i($spec, $start_match, $end_match);
+
+    # If we're running under a slave editor, force it to show the lines.
+    if ($slave_editor) {
+        print {$OUT} "\032\032$filename:$i:0\n";
+        $i = $end;
+    }
+    # We're doing it ourselves. We want to show the line and special
+    # markers for:
+    # - the current line in execution
+    # - whether a line is breakable or not
+    # - whether a line has a break or not
+    # - whether a line has an action or not
+    else {
+        I_TO_END:
+        for ( ; $i <= $end ; $i++ ) {
+
+            # Check for breakpoints and actions.
+            my ( $stop, $action );
+            if ($dbline{$i}) {
+                ( $stop, $action ) = split( /\0/, $dbline{$i} );
+            }
+
+            # ==> if this is the current line in execution,
+            # : if it's breakable.
+            my $arrow =
+            ( $i == $current_line and $filename eq $filename_ini )
+            ? '==>'
+            : ( $dbline[$i] + 0 ? ':' : ' ' );
+
+            # Add break and action indicators.
+            $arrow .= 'b' if $stop;
+            $arrow .= 'a' if $action;
+
+            # Print the line.
+            print {$OUT} "$i$arrow\t", $dbline[$i];
+
+            # Move on to the next line. Drop out on an interrupt.
+            if ($signal) {
+                $i++;
+                last I_TO_END;
+            }
+        } ## end for (; $i <= $end ; $i++)
+
+        # Line the prompt up; print a newline if the last line listed
+        # didn't have a newline.
+        if ($dbline[ $i - 1 ] !~ /\n\z/) {
+            print {$OUT} "\n";
+        }
+    } ## end else [ if ($slave_editor)
+
+    # Save the point we last listed to in case another relative 'l'
+    # command is desired. Don't let it run off the end.
+    $start = $i;
+    _minify_to_max(\$start);
+
+    return;
+}
+
+sub _cmd_l_main {
+    my $spec = shift;
+
+    # If this is '-something', delete any spaces after the dash.
+    $spec =~ s/\A-\s*\z/-/;
+
+    # If the line is '$something', assume this is a scalar containing a
+    # line number.
+    # Set up for DB::eval() - evaluate in *user* context.
+    if ( my ($var_name) = $spec =~ /\A(\$.*)/s ) {
+        return _cmd_l_handle_var_name($var_name);
+    }
+    # l name. Try to find a sub by that name.
+    elsif ( ($subname) = $spec =~ /\A([\':A-Za-z_][\':\w]*(?:\[.*\])?)/s ) {
+        return _cmd_l_handle_subname();
+    }
+    # Bare 'l' command.
+    elsif ( $spec !~ /\S/ ) {
+        return _cmd_l_empty();
+    }
+    # l [start]+number_of_lines
+    elsif ( my ($new_start, $new_incr) = $spec =~ /\A(\d*)\+(\d*)\z/ ) {
+        return _cmd_l_plus($new_start, $new_incr);
+    }
+    # l start-stop or l start,stop
+    elsif (my ($s, $e) = $spec =~ /^(?:(-?[\d\$\.]+)(?:[-,]([\d\$\.]+))?)?/ ) {
+        return _cmd_l_range($spec, $line, $s, $e);
+    }
+
+    return;
+} ## end sub cmd_l
+
+sub _DB__handle_l_command {
+    my $self = shift;
+
+    _cmd_l_main($self->cmd_args);
+    next CMD;
+}
+
+
 # 't' is type.
 # 'm' is method.
 # 'v' is the value (i.e: method name or subroutine ref).
@@ -2563,6 +2837,7 @@ BEGIN
     'c' => { t => 's', v => \&_DB__handle_c_command, },
     'f' => { t => 's', v => \&_DB__handle_f_command, },
     'i' => { t => 's', v => \&_DB__handle_i_command, },
+    'l' => { t => 's', v => \&_DB__handle_l_command, },
     'm' => { t => 's', v => \&_DB__handle_m_command, },
     'n' => { t => 'm', v => '_handle_n_command', },
     'p' => { t => 'm', v => '_handle_p_command', },
@@ -2583,7 +2858,7 @@ BEGIN
         { t => 's', v => \&_DB__handle_restart_and_rerun_commands, },
         } qw(R rerun)),
     (map { $_ => {t => 'm', v => '_handle_cmd_wrapper_commands' }, }
-        qw(a A b B e E h l L M o O v w W)),
+        qw(a A b B e E h L M o O v w W)),
 );
 };
 
@@ -5500,278 +5775,6 @@ sub cmd_h {
     }
 } ## end sub cmd_h
 
-=head3 C<cmd_l> - list lines (command)
-
-Most of the command is taken up with transforming all the different line
-specification syntaxes into 'start-stop'. After that is done, the command
-runs a loop over C<@dbline> for the specified range of lines. It handles
-the printing of each line and any markers (C<==E<gt>> for current line,
-C<b> for break on this line, C<a> for action on this line, C<:> for this
-line breakable).
-
-We save the last line listed in the C<$start> global for further listing
-later.
-
-=cut
-
-sub _min {
-    my $min = shift;
-    foreach my $v (@_) {
-        if ($min > $v) {
-            $min = $v;
-        }
-    }
-    return $min;
-}
-
-sub _max {
-    my $max = shift;
-    foreach my $v (@_) {
-        if ($max < $v) {
-            $max = $v;
-        }
-    }
-    return $max;
-}
-
-sub _minify_to_max {
-    my $ref = shift;
-
-    $$ref = _min($$ref, $max);
-
-    return;
-}
-
-sub _cmd_l_handle_var_name {
-    my $var_name = shift;
-
-    $evalarg = $var_name;
-
-    my ($s) = DB::eval();
-
-    # Ooops. Bad scalar.
-    if ($@) {
-        print {$OUT} "Error: $@\n";
-        next CMD;
-    }
-
-    # Good scalar. If it's a reference, find what it points to.
-    $s = CvGV_name($s);
-    print {$OUT} "Interpreted as: $1 $s\n";
-    $line = "$1 $s";
-
-    # Call self recursively to really do the command.
-    return _cmd_l_main( $s );
-}
-
-sub _cmd_l_handle_subname {
-
-    my $s = $subname;
-
-    # De-Perl4.
-    $subname =~ s/\'/::/;
-
-    # Put it in this package unless it starts with ::.
-    $subname = $package . "::" . $subname unless $subname =~ /::/;
-
-    # Put it in CORE::GLOBAL if t doesn't start with :: and
-    # it doesn't live in this package and it lives in CORE::GLOBAL.
-    $subname = "CORE::GLOBAL::$s"
-    if not defined &$subname
-        and $s !~ /::/
-        and defined &{"CORE::GLOBAL::$s"};
-
-    # Put leading '::' names into 'main::'.
-    $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
-
-    # Get name:start-stop from find_sub, and break this up at
-    # colons.
-    my @pieces = split( /:/, find_sub($subname) || $sub{$subname} );
-
-    # Pull off start-stop.
-    my $subrange = pop @pieces;
-
-    # If the name contained colons, the split broke it up.
-    # Put it back together.
-    $file = join( ':', @pieces );
-
-    # If we're not in that file, switch over to it.
-    if ( $file ne $filename ) {
-        if (! $slave_editor) {
-            print {$OUT} "Switching to file '$file'.\n";
-        }
-
-        # Switch debugger's magic structures.
-        *dbline   = $main::{ '_<' . $file };
-        $max      = $#dbline;
-        $filename = $file;
-    } ## end if ($file ne $filename)
-
-    # Subrange is 'start-stop'. If this is less than a window full,
-    # swap it to 'start+', which will list a window from the start point.
-    if ($subrange) {
-        if ( eval($subrange) < -$window ) {
-            $subrange =~ s/-.*/+/;
-        }
-
-        # Call self recursively to list the range.
-        return _cmd_l_main( $subrange );
-    } ## end if ($subrange)
-
-    # Couldn't find it.
-    else {
-        print {$OUT} "Subroutine $subname not found.\n";
-        return;
-    }
-}
-
-sub _cmd_l_empty {
-    # Compute new range to list.
-    $incr = $window - 1;
-
-    # Recurse to do it.
-    return _cmd_l_main( $start . '-' . ( $start + $incr ) );
-}
-
-sub _cmd_l_plus {
-    my ($new_start, $new_incr) = @_;
-
-    # Don't reset start for 'l +nnn'.
-    $start = $new_start if $new_start;
-
-    # Increment for list. Use window size if not specified.
-    # (Allows 'l +' to work.)
-    $incr = $new_incr || ($window - 1);
-
-    # Create a line range we'll understand, and recurse to do it.
-    return _cmd_l_main( $start . '-' . ( $start + $incr ) );
-}
-
-sub _cmd_l_calc_initial_end_and_i {
-    my ($spec, $start_match, $end_match) = @_;
-
-    # Determine end point; use end of file if not specified.
-    my $end = ( !defined $start_match ) ? $max :
-    ( $end_match ? $end_match : $start_match );
-
-    # Go on to the end, and then stop.
-    _minify_to_max(\$end);
-
-    # Determine start line.
-    my $i = $start_match;
-
-    if ($i eq '.') {
-        $i = $spec;
-    }
-
-    $i = _max($i, 1);
-
-    $incr = $end - $i;
-
-    return ($end, $i);
-}
-
-sub _cmd_l_range {
-    my ($spec, $current_line, $start_match, $end_match) = @_;
-
-    my ($end, $i) =
-        _cmd_l_calc_initial_end_and_i($spec, $start_match, $end_match);
-
-    # If we're running under a slave editor, force it to show the lines.
-    if ($slave_editor) {
-        print {$OUT} "\032\032$filename:$i:0\n";
-        $i = $end;
-    }
-    # We're doing it ourselves. We want to show the line and special
-    # markers for:
-    # - the current line in execution
-    # - whether a line is breakable or not
-    # - whether a line has a break or not
-    # - whether a line has an action or not
-    else {
-        I_TO_END:
-        for ( ; $i <= $end ; $i++ ) {
-
-            # Check for breakpoints and actions.
-            my ( $stop, $action );
-            if ($dbline{$i}) {
-                ( $stop, $action ) = split( /\0/, $dbline{$i} );
-            }
-
-            # ==> if this is the current line in execution,
-            # : if it's breakable.
-            my $arrow =
-            ( $i == $current_line and $filename eq $filename_ini )
-            ? '==>'
-            : ( $dbline[$i] + 0 ? ':' : ' ' );
-
-            # Add break and action indicators.
-            $arrow .= 'b' if $stop;
-            $arrow .= 'a' if $action;
-
-            # Print the line.
-            print {$OUT} "$i$arrow\t", $dbline[$i];
-
-            # Move on to the next line. Drop out on an interrupt.
-            if ($signal) {
-                $i++;
-                last I_TO_END;
-            }
-        } ## end for (; $i <= $end ; $i++)
-
-        # Line the prompt up; print a newline if the last line listed
-        # didn't have a newline.
-        if ($dbline[ $i - 1 ] !~ /\n\z/) {
-            print {$OUT} "\n";
-        }
-    } ## end else [ if ($slave_editor)
-
-    # Save the point we last listed to in case another relative 'l'
-    # command is desired. Don't let it run off the end.
-    $start = $i;
-    _minify_to_max(\$start);
-
-    return;
-}
-
-sub _cmd_l_main {
-    my $spec = shift;
-
-    # If this is '-something', delete any spaces after the dash.
-    $spec =~ s/\A-\s*\z/-/;
-
-    # If the line is '$something', assume this is a scalar containing a
-    # line number.
-    # Set up for DB::eval() - evaluate in *user* context.
-    if ( my ($var_name) = $spec =~ /\A(\$.*)/s ) {
-        return _cmd_l_handle_var_name($var_name);
-    }
-    # l name. Try to find a sub by that name.
-    elsif ( ($subname) = $spec =~ /\A([\':A-Za-z_][\':\w]*(?:\[.*\])?)/s ) {
-        return _cmd_l_handle_subname();
-    }
-    # Bare 'l' command.
-    elsif ( $spec !~ /\S/ ) {
-        return _cmd_l_empty();
-    }
-    # l [start]+number_of_lines
-    elsif ( my ($new_start, $new_incr) = $spec =~ /\A(\d*)\+(\d*)\z/ ) {
-        return _cmd_l_plus($new_start, $new_incr);
-    }
-    # l start-stop or l start,stop
-    elsif (my ($s, $e) = $spec =~ /^(?:(-?[\d\$\.]+)(?:[-,]([\d\$\.]+))?)?/ ) {
-        return _cmd_l_range($spec, $line, $s, $e);
-    }
-
-    return;
-} ## end sub cmd_l
-
-sub cmd_l {
-    my (undef, $line) = @_;
-
-    return _cmd_l_main($line);
-}
-
 =head3 C<cmd_L> - list breakpoints, actions, and watch expressions (command)
 
 To list breakpoints, the command has to look determine where all of them are