Break upon <filename>:<line>

4 files changed, 84 insertions, 4 deletions

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index fcc111e182..89118f685f 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -4077,7 +4077,7 @@ sub cmd_b {
     my $dbline = shift;
 
     # Make . the current line number if it's there..
-    $line =~ s/^\./$dbline/;
+    $line =~ s/^\.\b/$dbline/;
 
     # No line number, no condition. Simple break on current line.
     if ( $line =~ /^\s*$/ ) {
@@ -4115,7 +4115,15 @@ sub cmd_b {
         # Save the break type for this sub.
         $postponed{$subname} = $break ? "break +0 if $cond" : "compile";
     } ## end elsif ($line =~ ...
-
+    # b <filename>:<line> [<condition>]
+    elsif ($line =~ /\A(\S+[^:]):(\d+)\s*(.*)/ms) {
+        my ($filename, $line_num, $cond) = ($1, $2, $3);
+        cmd_b_filename_line(
+            $filename,
+            $line_num, 
+            (length($cond) ? $cond : '1'),
+        );
+    }
     # b <sub name> [<condition>]
     elsif ( $line =~ /^([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/ ) {
 
@@ -4409,6 +4417,20 @@ sub cmd_b_line {
     };
 } ## end sub cmd_b_line
 
+=head3 cmd_b_filename_line(line, [condition]) (command)
+
+Wrapper for C<break_on_filename_line>. Prints the failure message if it 
+doesn't work.
+
+=cut 
+
+sub cmd_b_filename_line {
+    eval { break_on_filename_line(@_); 1 } or do {
+        local $\ = '';
+        print $OUT $@ and return;
+    };
+}
+
 =head3 break_on_filename_line(file, line, [condition]) (API)
 
 Switches to the file specified and then calls C<break_on_line> to set 
@@ -9266,7 +9288,6 @@ sub cmd_pre580_b {
         my $cond = length $2 ? $2 : '1';
         &cmd_b_sub( $subname, $cond );
     }
-
     # b <line> [<condition>].
     elsif ( $cmd =~ /^(\d*)\s*(.*)/ ) {
         my $i = $1 || $dbline;
diff --git a/lib/perl5db.t b/lib/perl5db.t
index f4f32dacae..2cc1ead41f 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -27,7 +27,7 @@ my $dev_tty = '/dev/tty';
     }
 }
 
-plan(10);
+plan(11);
 
 sub rc {
     open RC, ">", ".perldb" or die $!;
@@ -159,6 +159,36 @@ SKIP: {
     is($output, "", "proxy constant subroutines");
 }
 
+# Testing that we can set a line in the middle of the file.
+{
+    rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+    push (@DB::typeahead,
+    'b ../lib/perl5db/t/MyModule.pm:12',
+    'c',
+    q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
+    'c',
+    'q',
+    );
+
+}
+EOF
+
+    my $output = runperl(switches => [ '-d', '-I', '../lib/perl5db/t', ], stderr => 1, progfile => '../lib/perl5db/t/filename-line-breakpoint');
+
+    like($output, qr/
+        ^Var=Bar$
+            .*
+        ^In\ MyModule\.$
+            .*
+        ^In\ Main\ File\.$
+            .*
+        /msx, 
+        "Can set breakpoint in a line in the middle of the file.");
+}
+
 
 # [perl #66110] Call a subroutine inside a regex
 {
diff --git a/lib/perl5db/t/MyModule.pm b/lib/perl5db/t/MyModule.pm
new file mode 100644
index 0000000000..6a72fac484
--- /dev/null
+++ b/lib/perl5db/t/MyModule.pm
@@ -0,0 +1,15 @@
+package MyModule;
+
+use strict;
+use warnings;
+
+use vars qw($var);
+
+$var = "Bar";
+
+sub function
+{
+    print "In MyModule.\n";
+}
+
+1;
diff --git a/lib/perl5db/t/filename-line-breakpoint b/lib/perl5db/t/filename-line-breakpoint
new file mode 100644
index 0000000000..8331175841
--- /dev/null
+++ b/lib/perl5db/t/filename-line-breakpoint
@@ -0,0 +1,14 @@
+#!/perl
+
+use strict;
+use warnings;
+
+use MyModule;
+
+my $x = "Foo";
+
+MyModule::function();
+
+print "In Main File.\n";
+
+1;