[FIX] Make debugger l range specs sane

Fixes 21350.

The pattern which matches valid line number ranges in the debugger is
far too complaisant when it comes to strings it will accept. A number of
completely nonsensical values are cheerfully accepted and produce
results that range from nothing at all to very odd results indeed:

 - specifying a float for a line number appends the fractional part of
   the float to ALL line numbers until something else sets the starting
   line number to an integer again.
 - Strings like `.$.$.$`, `.....`, and `22.$` are all acccepted. Some do
   nothing, some generate errors.
 - Negative line numbers are accepted but do nothing.

This tracks back to a catchall line-range pattern that was added in the
Perl *3* debugger at commit a687059. This pattern looks as if it
were added to eventually implement a number of things, including lines
relative to the current line, negative indexes into the magic source
code array, variable references, and so on. Several of these were
implemented elsewhere in the debugger, but the regex was never
simplified. This change breaks up that regex and cleans up a few others
(including code that internally generates possible negative line
numbers).

Changes to the old catchall regex:
 - Remove the conditional match of a leading `-`. Negative line numbers
   are not permitted, at all. The code that generated them internally
   has been fixed so it does not do so.
 - Remove `$` as a valid character in a linespec in the catchall regex.
   `$scalar` is handled explicitly in the _cmd_l_main code. There is no
   other documented use for bare '$' in a list linespec, even though it
   is accepted.
 - The linespec character class treated `.`,  and digits, as equally
   valid characters in a linespec. This led to the linespecs matching
   floating point numbers, IPv4 addresses, and various nonnumeric
   nonsense that did not translate to a valid line number. The combined
   character match was split into either a single period (handled
   already as "the current line") or a series of digits _only_ (a
   possible line number). This had to be done for both the starting and
   ending linespec.
 - \A and \z were added to the catchall regex to ensure that it matched
   the whole of the remaining line, or failed. This prevents things like
   `...` from being matched as equivalent to `.` alone.
 - Make sure the 'v' command creates good linespecs internally. As
   previously coded, this could generate linespecs that started with a
   negative number. Since we've outlawed negative numbers in linespecs,
   a `v` too close to the start of the file (as occurs in the tests for
   perl5db.pl) would cause the more-stringent range check to throw an
   error.  Instead, the 'v' command now checks the generated step back
   and sets it to 1 if it is less than 1. The existing test is
   sufficient to confirm that the new code in cmd_v fixes the issue.
 - Verify that floating-point line numbers are illegal: This was the
   original bug that triggered this change: the original regex accepted
   floating-point numbers, and because indexing an array in Perl with a
   float works due toimplicit type conversions, and the increment of a
   float by (integer) 1 doesn't downgrade the float to an int, the line
   numbers continued to be displayed with the fractional portion of the
   original number until something intervened with an explicit or
   implicit integer linespec.  We simply don't permit them to be
   specified as line numbers now.
 - Use \w for valid variable name characters: The debugger should eventually
   be UTF-8 compatible, but is not; this is a step along the way to get there.
   It makes the variable match in the cmd_l reference parsing code match
   proper Perl variable names, including UTF-8 "word" characters, and
   now also properly matches regex result variables ($1, $2, etc.). It
   explicitly rules out bare $, which the old regex would match,
   triggering an error. (For now, we've added the `/a` flag to the match
   to ensure only ASCII matches, since the rest of the code isn't
   prepared to handle non-ASCII numerics.)
 - A new perldb/t test file was added to verify that all the range
   cleanups work properly, along with new stanzas in the perl5db.pl test
   suite. It simply lets us start up the debugger and have a place to
   run the bad linespecs from to verify they do _not_ work.

Changes from @mauke's code review

 - Actually add the new test file to MANIFEST, d'oh.
 - Vastly simpler `_cmd_l_calc_initial_end_and_i` logic. Also more
   likely to actually be correct.
 - More precise variable name matching for `l $scalar`.
 - Purposefully limit line spec numbers to ASCII.
 - Update debugger version to pass porting/cmp_version.t.

Clean up calling sequences

The calling sequences were not always consistent, and some of the
changes to clean up the code ment that variables formerly passed in now
no longer needed to be. One sub was using a variable in the caller; this
was fixed to be passed in explicitly.

 - _cmd_l_handle_var_name now gets $subname passed in
 - _cmd_l_calc_initial_end_and_i no longer needs spec
 - _cmd_l_calc_initial_end_and_i chained teriary replaced with chanined
   defined-or

Author: joemcmahon

MANIFEST

@@ -5430,6 +5430,7 @@ lib/perl5db/t/filename-line-breakpoint			Tests for the Perl debugger
 lib/perl5db/t/gh-17660					Tests for the Perl debugger
 lib/perl5db/t/gh-17661					Tests for the Perl debugger
 lib/perl5db/t/gh-17661b					Tests for the Perl debugger
+lib/perl5db/t/gh-21350					Tests for the Perl debugger
 lib/perl5db/t/load-modules				Tests for the Perl debugger
 lib/perl5db/t/lsub-n					Test script used by perl5db.t
 lib/perl5db/t/lvalue-bug				Tests for the Perl debugger

lib/perl5db.pl

@@ -532,7 +532,7 @@ BEGIN
 use vars qw($VERSION $header);
 
 # bump to X.XX in blead, only use X.XX_XX in maint
-$VERSION = '1.77';
+$VERSION = '1.78';
 
 $header = "perl5db.pl version $VERSION";
 
@@ -2609,7 +2609,7 @@ sub _cmd_l_handle_var_name {
 
 sub _cmd_l_handle_subname {
 
-    my $s = $subname;
+    my $s = my $subname = shift;
 
     # De-Perl4.
     $subname =~ s/\'/::/;
@@ -2620,9 +2620,9 @@ sub _cmd_l_handle_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"};
+        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 "::";
@@ -2691,34 +2691,25 @@ sub _cmd_l_plus {
 }
 
 sub _cmd_l_calc_initial_end_and_i {
-    my ($spec, $start_match, $end_match) = @_;
+    my ($current_line, $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.
+    my $end = $end_match // $start_match // $max;
+    # Clean up the end spec if needed.
+    $end = $current_line if $end eq '.';
     _minify_to_max(\$end);
 
-    # Determine start line.
-    my $i = $start_match;
-
-    if ($i eq '.') {
-        $i = $spec;
-    }
-
-    $i = _max($i, 1);
-
-    $incr = $end - $i;
+    # Determine the loop start point.
+    my $i = $start_match // 1;
+    $i = $current_line if $i eq '.';
 
     return ($end, $i);
 }
 
 sub _cmd_l_range {
-    my ($spec, $current_line, $start_match, $end_match) = @_;
+    my ($current_line, $start_match, $end_match) = @_;
 
     my ($end, $i) =
-        _cmd_l_calc_initial_end_and_i($spec, $start_match, $end_match);
+        _cmd_l_calc_initial_end_and_i($current_line, $start_match, $end_match);
 
     # If we're running under a client editor, force it to show the lines.
     if ($client_editor) {
@@ -2780,18 +2771,15 @@ sub _cmd_l_range {
 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);
+    if ( $spec =~ /\A(\$(?:[0-9]+|[^\W\d]\w*))\z/ ) {
+        return _cmd_l_handle_var_name($spec);
     }
     # l name. Try to find a sub by that name.
     elsif ( ($subname) = $spec =~ /\A([\':A-Za-z_][\':\w]*(?:\[.*\])?)/s ) {
-        return _cmd_l_handle_subname();
+        return _cmd_l_handle_subname($subname);
     }
     # Bare 'l' command.
     elsif ( $spec !~ /\S/ ) {
@@ -2802,8 +2790,13 @@ sub _cmd_l_main {
         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);
+    # Purposefully limited to ASCII; UTF-8 support would be nice sometime.
+    elsif (my ($s, $e) = $spec =~ /\A(?:(\.|\d+)(?:[-,](\.|\d+))?)?\z/a ) {
+        return _cmd_l_range($line, $s, $e);
+    }
+    # Protest at bizarre and incorrect specs.
+    else {
+        print {$OUT} "Invalid line specification '$spec'.\n";
     }
 
     return;
@@ -6033,8 +6026,9 @@ sub cmd_v {
         # Set the start to the argument given (if there was one).
         $start = $1 if $1;
 
-        # Back up by the context amount.
+        # Back up by the context amount. Don't back up past line 1.
         $start -= $preview;
+        $start = 1  unless $start > 0;
 
         # Put together a linespec that _cmd_l_main will like.
         $line = $start . '-' . ( $start + $incr );

lib/perl5db.t

@@ -3296,6 +3296,177 @@ EOS
                           "[github #19198] check we stopped correctly");
 }
 
+{
+    # gh-21350: verify that nonsense linespecs are rejected #1
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l ...',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/gh-21350',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr/Invalid line specification '...'/,
+        q/gh-21350: multiple periods rejected/,
+    );
+}
+
+{
+    # gh-21350: verify that nonsense linespecs are rejected #2
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l $',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/gh-21350',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr/Invalid line specification '\$'/,
+        q/gh-21350: $ rejected/,
+    );
+}
+
+{
+    # gh-21350: verify that nonsense linespecs are rejected #3
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l 2.71828',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/gh-21350',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr/Invalid line specification '2\.71828'/,
+        q/gh-21350: floating-point rejected/,
+    );
+}
+
+{
+    # gh-21350: verify that nonsense linespecs are rejected #4
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l 1.1.1.1',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/gh-21350',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr/Invalid line specification '1\.1\.1\.1'/,
+        q/gh-21350: IPv4 address rejected/,
+    );
+}
+
+{
+    # gh-21350: verify that nonsense linespecs are rejected #5
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l -.',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/gh-21350',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr/Invalid line specification '-\.'/,
+        q/gh-21350: invalid partial range rejected/,
+    );
+}
+
+{
+    # gh-21350: verify that nonsense linespecs are rejected #6
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l -$.',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/gh-21350',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr/Invalid line specification '\-\$\.'/,
+        q/gh-21350: formerly acceptable nonsense rejected/,
+    );
+}
+
+{
+    # gh-21350: verify that nonsense linespecs are rejected #7
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l -12',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/gh-21350',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr/Invalid line specification '-12'/,
+        q/gh-21350: negative line number rejected/,
+    );
+}
+
+{
+    # gh-21350: verify that nonsense linespecs are rejected #8
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l 17$',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/gh-21350',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr/Invalid line specification '17\$'/,
+        q/gh-21350: line number with trailing $ rejected/,
+    );
+}
+
+{
+    # gh-21350: verify that nonsense linespecs are rejected #9
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l $2250$',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/gh-21350',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr/Invalid line specification '\$2250\$'/,
+        q/gh-21350: match variable with trailing $ rejected/,
+    );
+}
+
 done_testing();
 
 END {

lib/perl5db/t/gh-21350

@@ -0,0 +1,3 @@
+#!perl
+
+print "minimal program to allow the debugger to launch\n";