[perl.git] branch blead, updated. v5.15.5-348-g5d5d9ea

[Tony Cook]

In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/5d5d9ea3ae69424edca11bf2237f2504fa313408?hp=7e7629faf067b99cf5b2d8e61fef8c0a0a4f47f7>

- Log -----------------------------------------------------------------
commit 5d5d9ea3ae69424edca11bf2237f2504fa313408
Author: Shlomi Fish <shlo...@iglu.org.il>
Date:   Wed Dec 7 19:36:39 2011 +0200

    Made "c [line_num]" working again.
    
    This is a bug-fix to
    https://rt.perl.org/rt3//Public/Bug/Display.html?id=104820 .
    
    Both the fix and a regression tests were added.
-----------------------------------------------------------------------

Summary of changes:
 lib/perl5db.pl |   31 +++++++++++++++++++++++++++++--
 lib/perl5db.t  |   24 +++++++++++++++++++++++-
 2 files changed, 52 insertions(+), 3 deletions(-)

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 84a38f1..f62f2ab 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -1956,7 +1956,10 @@ sub DB {
         elsif ($stop) {
             $evalarg = "\$DB::signal |= 1 if do {$stop}";
             &eval;
-            $dbline{$line} =~ s/;9($|\0)/$1/;
+            # If the breakpoint is temporary, then delete its enabled status.
+            if ($dbline{$line} =~ s/;9($|\0)/$1/) {
+                _cancel_breakpoint_temp_enabled_status($filename, $line);
+            }
         }
     } ## end if ($dbline{$line} && ...
 
@@ -2812,6 +2815,7 @@ in this and all call levels above this one.
 
                         # Yes. Set up the one-time-break sigil.
                         $dbline{$i} =~ s/($|\0)/;9$1/;  # add one-time-only 
b.p.
+                        _enable_breakpoint_temp_enabled_status($filename, $i);
                     } ## end if ($i)
 
                     # Turn off stack tracing from here up.
@@ -4002,10 +4006,33 @@ sub _set_breakpoint_enabled_status {
     return;
 }
 
+sub _enable_breakpoint_temp_enabled_status {
+    my ($filename, $line) = @_;
+
+    _get_breakpoint_data_ref($filename, $line)->{'temp_enabled'} = 1;
+
+    return;
+}
+
+sub _cancel_breakpoint_temp_enabled_status {
+    my ($filename, $line) = @_;
+
+    my $ref = _get_breakpoint_data_ref($filename, $line);
+    
+    delete ($ref->{'temp_enabled'});
+
+    if (! %$ref) {
+        _delete_breakpoint_data_ref($filename, $line);
+    }
+
+    return;
+}
+
 sub _is_breakpoint_enabled {
     my ($filename, $line) = @_;
 
-    return _get_breakpoint_data_ref($filename, $line)->{'enabled'};
+    my $data_ref = _get_breakpoint_data_ref($filename, $line);
+    return ($data_ref->{'enabled'} || $data_ref->{'temp_enabled'});
 }
 
 =head2 C<cmd_wrapper()> (API)
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 0adae25..ba5d585 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(19);
+plan(20);
 
 my $rc_filename = '.perldb';
 
@@ -434,6 +434,28 @@ EOF
         "Restart and delete all breakpoints work properly.");
 }
 
+{
+    rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+    push (@DB::typeahead,
+    'c 15',
+    q/print "X={$x}\n";/,
+    'c',
+    'q',
+    );
+
+}
+EOF
+
+    my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => 
'../lib/perl5db/t/disable-breakpoints-1'); +
+    like($output, qr/
+        X=\{ThirdVal\}
+        /msx,
+        "'c line_num' is working properly.");
+}
+
 END {
     1 while unlink ($rc_filename, $out_fn);
 }

--
Perl5 Master Repository