Add enable/disable commands for breakpoints in perl -d

diff --git a/MANIFEST b/MANIFEST
index 5f696c8..9c7e027 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4047,6 +4047,10 @@ lib/overload.t                   See if operator overloading works
 lib/perl5db.pl                 Perl debugging routines
 lib/perl5db.t                  Tests for the Perl debugger
 lib/perl5db/t/breakpoint-bug   Test script used by perl5db.t
+lib/perl5db/t/disable-breakpoints-1    Test script used by perl5db.t
+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/filename-line-breakpoint         Tests for the Perl debugger
 lib/perl5db/t/lvalue-bug       Tests for the Perl debugger

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 89118f6..3d17d8f 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -1929,6 +1929,7 @@ sub DB {
 
     # if we have something here, see if we should break.
     if ( $dbline{$line}
+        && _is_breakpoint_enabled($filename, $line)
         && ( ( $stop, $action ) = split( /\0/, $dbline{$line} ) ) )
     {
 
@@ -3275,6 +3276,38 @@ pick it up.
                     next CMD;
                 };
 
+                $cmd =~ /^(enable|disable)\s+(\S+)\s*$/ && do {
+                    my ($cmd, $position) = ($1, $2);
+
+                    my ($fn, $line_num);
+                    if ($position =~ m{\A\d+\z})
+                    {
+                        $fn = $filename;
+                        $line_num = $position;
+                    }
+                    elsif ($position =~ m{\A(.*):(\d+)\z})
+                    {
+                        ($fn, $line_num) = ($1, $2);
+                    }
+                    else
+                    {
+                        &warn("Wrong spec for enable/disable argument.\n");
+                    }
+
+                    if (defined($fn)) {
+                        if (_has_breakpoint_data_ref($fn, $line_num)) {
+                            _set_breakpoint_enabled_status($fn, $line_num,
+                                ($cmd eq 'enable' ? 1 : '')
+                            );
+                        }
+                        else {
+                            &warn("No breakpoint set at ${fn}:${line_num}\n");
+                        }
+                    }
+
+                    next CMD;
+                };
+
 =head4 C<save> - send current history to a file
 
 Takes the complete history, (not the shrunken version you see with C<H>),
@@ -3905,6 +3938,51 @@ my %set = (    #
     },
 );
 
+my %breakpoints_data;
+
+sub _has_breakpoint_data_ref {
+    my ($filename, $line) = @_;
+
+    return (
+        exists( $breakpoints_data{$filename} )
+            and
+        exists( $breakpoints_data{$filename}{$line} )
+    );
+}
+
+sub _get_breakpoint_data_ref {
+    my ($filename, $line) = @_;
+
+    return ($breakpoints_data{$filename}{$line} ||= +{});
+}
+
+sub _delete_breakpoint_data_ref {
+    my ($filename, $line) = @_;
+
+    delete($breakpoints_data{$filename}{$line});
+    if (! scalar(keys( %{$breakpoints_data{$filename}} )) ) {
+        delete($breakpoints_data{$filename});
+    }
+
+    return;
+}
+
+sub _set_breakpoint_enabled_status {
+    my ($filename, $line, $status) = @_;
+
+    _get_breakpoint_data_ref($filename, $line)->{'enabled'} =
+        ($status ? 1 : '')
+        ;
+
+    return;
+}
+
+sub _is_breakpoint_enabled {
+    my ($filename, $line) = @_;
+
+    return _get_breakpoint_data_ref($filename, $line)->{'enabled'};
+}
+
 =head2 C<cmd_wrapper()> (API)
 
 C<cmd_wrapper()> allows the debugger to switch command sets 
@@ -4400,6 +4478,8 @@ sub break_on_line {
 
         # Nothing here - just add the condition.
         $dbline{$i} = $cond;
+
+        _set_breakpoint_enabled_status($filename, $i, 1);
     }
 } ## end sub break_on_line
 
@@ -4644,6 +4724,8 @@ are no magical debugger structures associated with them.
 sub delete_breakpoint {
     my $i = shift;
 
+    my $fn = $filename;
+
     # If we got a line, delete just that one.
     if ( defined($i) ) {
 
@@ -4654,7 +4736,10 @@ sub delete_breakpoint {
         $dbline{$i} =~ s/^[^\0]*//;
 
         # Remove the entry entirely if there's no action left.
-        delete $dbline{$i} if $dbline{$i} eq '';
+        if ($dbline{$i} eq '') {
+            delete $dbline{$i};
+            _delete_breakpoint_data_ref($fn, $i);
+        }
     }
 
     # No line; delete them all.
@@ -4683,6 +4768,7 @@ sub delete_breakpoint {
 
                         # Remove the entry altogether if no action is there.
                         delete $dbline{$i};
+                        _delete_breakpoint_data_ref($file, $i);
                     }
                 } ## end if (defined $dbline{$i...
             } ## end for ($i = 1 ; $i <= $max...

diff --git a/lib/perl5db.t b/lib/perl5db.t
index e275356..c8eb63e 100644 (file)
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(11);
+plan(14);
 
 my $rc_filename = '.perldb';
 
@@ -246,9 +246,88 @@ EOF
 }
 
 
+# Testing that we can disable a breakpoint at a numeric line.
+{
+    rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+    push (@DB::typeahead,
+    'b 7',
+    'b 11',
+    'disable 7',
+    'c',
+    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=\{SecondVal\}
+        /msx,
+        "Can set breakpoint in a line.");
+}
+
+# Testing that we can re-enable a breakpoint at a numeric line.
+{
+    rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+    push (@DB::typeahead,
+    'b 8',
+    'b 24',
+    'disable 24',
+    'c',
+    'enable 24',
+    'c',
+    q/print "X={$x}\n";/,
+    'c',
+    'q',
+    );
 
+}
+EOF
+
+    my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-2'); 
+    like($output, qr/
+        X=\{SecondValOneHundred\}
+        /msx,
+        "Can set breakpoint in a line.");
+}
 # clean up.
 
+# Disable and enable for breakpoints on outer files.
+{
+    rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+    push (@DB::typeahead,
+    'b 10',
+    'b ../lib/perl5db/t/EnableModule.pm:14',
+    'disable ../lib/perl5db/t/EnableModule.pm:14',
+    'c',
+    'enable ../lib/perl5db/t/EnableModule.pm:14',
+    'c',
+    q/print "X={$x}\n";/,
+    'c',
+    'q',
+    );
+
+}
+EOF
+
+    my $output = runperl(switches => [ '-d', '-I', '../lib/perl5db/t', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-3'); +
+    like($output, qr/
+        X=\{SecondValTwoHundred\}
+        /msx,
+        "Can set breakpoint in a line.");
+}
 END {
     1 while unlink ($rc_filename, $out_fn);
 }

diff --git a/lib/perl5db/t/EnableModule.pm b/lib/perl5db/t/EnableModule.pm
new file mode 100644 (file)
index 0000000..910a6db
--- /dev/null
+++ b/lib/perl5db/t/EnableModule.pm
@@ -0,0 +1,18 @@
+package EnableModule;
+
+use strict;
+use warnings;
+
+sub set_x
+{
+    my $x_ref = shift;
+
+    ${$x_ref} .= "TwoHundred";
+
+    my $x = ${$x_ref};
+
+    my $t = $x;
+    $t .= "Foo";
+}
+
+1;

diff --git a/lib/perl5db/t/disable-breakpoints-1 b/lib/perl5db/t/disable-breakpoints-1
new file mode 100644 (file)
index 0000000..10877d6
--- /dev/null
+++ b/lib/perl5db/t/disable-breakpoints-1
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+my $x = "One";
+my $dummy = 0;
+
+$x = "FirstVal";
+
+$dummy++;
+
+$x = "SecondVal";
+
+$dummy++;
+
+$x = "ThirdVal";
+
+$dummy++;
+
+$x = "FourthVal";
+
+$dummy++;

diff --git a/lib/perl5db/t/disable-breakpoints-2 b/lib/perl5db/t/disable-breakpoints-2
new file mode 100644 (file)
index 0000000..a3ab166
--- /dev/null
+++ b/lib/perl5db/t/disable-breakpoints-2
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+my $x = "One";
+
+$x = "FirstVal";
+
+set_x();
+
+$x = "SecondVal";
+
+set_x();
+
+$x = "ThirdVal";
+
+set_x();
+
+$x = "FourthVal";
+
+set_x();
+
+sub set_x
+{
+    $x .= "OneHundred";
+
+    my $t = $x;
+    $t .= "Foo";
+}

diff --git a/lib/perl5db/t/disable-breakpoints-3 b/lib/perl5db/t/disable-breakpoints-3
new file mode 100644 (file)
index 0000000..990abb1
--- /dev/null
+++ b/lib/perl5db/t/disable-breakpoints-3
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+use EnableModule;
+my $x = "One";
+
+$x = "FirstVal";
+
+EnableModule::set_x(\$x);
+
+$x = "SecondVal";
+
+EnableModule::set_x(\$x);
+
+$x = "ThirdVal";
+
+EnableModule::set_x(\$x);
+
+$x = "FourthVal";
+
+EnableModule::set_x(\$x);
+

diff --git a/pod/perldebug.pod b/pod/perldebug.pod
index 73e4f80..89334eb 100644 (file)
--- a/pod/perldebug.pod
+++ b/pod/perldebug.pod
@@ -352,6 +352,42 @@ X<debugger command, B>
 
 Delete all installed breakpoints.
 
+=item disable [file]:[line]
+X<breakpoint>
+X<debugger command, disable>
+X<disable>
+
+Disable the breakpoint so it won't stop the execution of the program. 
+Breakpoints are enabled by default and can be re-enabled using the C<enable>
+command.
+
+=item disable [line]
+X<breakpoint>
+X<debugger command, disable>
+X<disable>
+
+Disable the breakpoint so it won't stop the execution of the program. 
+Breakpoints are enabled by default and can be re-enabled using the C<enable>
+command.
+
+This is done for a breakpoint in the current file.
+
+=item enable [file]:[line]
+X<breakpoint>
+X<debugger command, disable>
+X<disable>
+
+Enable the breakpoint so it will stop the execution of the program. 
+
+=item enable [line]
+X<breakpoint>
+X<debugger command, disable>
+X<disable>
+
+Enable the breakpoint so it will stop the execution of the program. 
+
+This is done for a breakpoint in the current file.
+
 =item a [line] command
 X<debugger command, a>