From ea7bdd87ed0a0e43dbc038182ac2ebde79570a5e Mon Sep 17 00:00:00 2001
From: Vincent Pit <perl@profvince.com>
Date: Mon, 25 Jun 2012 15:06:49 +0200
Subject: [PATCH] Fix (and test) breakpoints on subroutines

They were broken since 'use strict' was added to the debugger.
---
 MANIFEST           |  1 +
 lib/perl5db.pl     | 10 +++++-----
 lib/perl5db.t      | 25 ++++++++++++++++++++++++-
 lib/perl5db/t/fact | 14 ++++++++++++++
 4 files changed, 44 insertions(+), 6 deletions(-)
 create mode 100644 lib/perl5db/t/fact

diff --git a/MANIFEST b/MANIFEST
index f9cb161..3fbacb5 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4280,6 +4280,7 @@ lib/perl5db/t/disable-breakpoints-2	Test script used by perl5db.t
 lib/perl5db/t/disable-breakpoints-3	Test script used by perl5db.t
 lib/perl5db/t/EnableModule.pm	Tests for the Perl debugger
 lib/perl5db/t/eval-line-bug	Tests for the Perl debugger
+lib/perl5db/t/fact		Tests for the Perl debugger
 lib/perl5db/t/filename-line-breakpoint		Tests for the Perl debugger
 lib/perl5db/t/lvalue-bug	Tests for the Perl debugger
 lib/perl5db/t/MyModule.pm	Tests for the Perl debugger
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 755d645..b692f6f 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -523,7 +523,7 @@ BEGIN {
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 use vars qw($VERSION $header);
 
-$VERSION = '1.39';
+$VERSION = '1.39_01';
 
 $header = "perl5db.pl version $VERSION";
 
@@ -4118,7 +4118,7 @@ sub cmd_b {
         $subname =~ s/\'/::/g;
 
         # Qualify it into the current package unless it's already qualified.
-        $subname = "${'package'}::" . $subname unless $subname =~ /::/;
+        $subname = "${package}::" . $subname unless $subname =~ /::/;
 
         # Add main if it starts with ::.
         $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
@@ -4565,7 +4565,7 @@ sub cmd_b_sub {
         my $s = $subname;
 
         # Put it in this package unless it's already qualified.
-        $subname = "${'package'}::" . $subname
+        $subname = "${package}::" . $subname
           unless $subname =~ /::/;
 
         # Requalify it into CORE::GLOBAL if qualifying it into this
@@ -8493,7 +8493,7 @@ sub db_complete {
     # The search pattern is current package, ::, extract the next qualifier
     # Prefix and pack are set to undef.
     my ( $itext, $search, $prefix, $pack ) =
-      ( $text, "^\Q${'package'}::\E([^:]+)\$" );
+      ( $text, "^\Q${package}::\E([^:]+)\$" );
 
 =head3 C<b postpone|compile> 
 
@@ -9326,7 +9326,7 @@ sub cmd_pre580_b {
         $subname =~ s/\'/::/g;
 
         # Qualify it into the current package unless it's already qualified.
-        $subname = "${'package'}::" . $subname
+        $subname = "${package}::" . $subname
           unless $subname =~ /::/;
 
         # Add main if it starts with ::.
diff --git a/lib/perl5db.t b/lib/perl5db.t
index c7633fc..634288c 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(30);
+plan(31);
 
 my $rc_filename = '.perldb';
 
@@ -808,6 +808,29 @@ package main;
         );
 }
 
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'b fact',
+                'c',
+                'c',
+                'c',
+                'n',
+                'print "<$n>"',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/fact',
+        }
+    );
+
+    $wrapper->output_like(
+        qr/<3>/,
+        'b subroutine works fine',
+    );
+}
+
 END {
     1 while unlink ($rc_filename, $out_fn);
 }
diff --git a/lib/perl5db/t/fact b/lib/perl5db/t/fact
new file mode 100644
index 0000000..ac25eac
--- /dev/null
+++ b/lib/perl5db/t/fact
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+sub fact {
+    my $n = shift;
+    if ($n > 1) {
+        return $n * fact($n - 1);
+    } else {
+        return 1;
+    }
+}
+fact(5);
-- 
2.7.4