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
# if we have something here, see if we should break.
if ( $dbline{$line}
+ && _is_breakpoint_enabled($filename, $line)
&& ( ( $stop, $action ) = split( /\0/, $dbline{$line} ) ) )
{
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>),
},
);
+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
# Nothing here - just add the condition.
$dbline{$i} = $cond;
+
+ _set_breakpoint_enabled_status($filename, $i, 1);
}
} ## end sub break_on_line
sub delete_breakpoint {
my $i = shift;
+ my $fn = $filename;
+
# If we got a line, delete just that one.
if ( defined($i) ) {
$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.
# 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...
}
}
-plan(11);
+plan(14);
my $rc_filename = '.perldb';
}
+# 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);
}
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>