[PATCH] perl -d bugfixes and tests - take 2

Hi all,

this patch fixes some bugs in "perl -d" and adds some regression tests (for the
bugfixes and for better test coverage). It can be found as several commits here:

https://github.com/shlomif/perl/tree/perl-d-add-tests

This patch fixes some relatively minor style issues reported by the P5P
participants.

More information can be found in the comments and test titles in
the patch.

Please apply it.

Regards,

	Shlomi Fish

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 06b1153..d8b6894 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -1098,6 +1098,9 @@ $trace = $signal = $single = 0;    # Uninitialized warning suppression
 # value when the 'r' command is used to return from a subroutine.
 $inhibit_exit = $option{PrintRet} = 1;
 
+# Default to 1 so the prompt will display the first line.
+$trace_to_depth = 1;
+
 =head1 OPTION PROCESSING
 
 The debugger's options are actually spread out over the debugger itself and 
@@ -1567,9 +1570,19 @@ if ( exists $ENV{PERLDB_RESTART} ) {
 
     # restore breakpoints/actions
     my @had_breakpoints = get_list("PERLDB_VISITED");
-    for ( 0 .. $#had_breakpoints ) {
-        my %pf = get_list("PERLDB_FILE_$_");
-        $postponed_file{ $had_breakpoints[$_] } = \%pf if %pf;
+    for my $file_idx ( 0 .. $#had_breakpoints ) {
+        my $filename = $had_breakpoints[$file_idx];
+        my %pf = get_list("PERLDB_FILE_$file_idx");
+        $postponed_file{ $filename } = \%pf if %pf;
+        my @lines = sort {$a <=> $b} keys(%pf);
+        my @enabled_statuses = get_list("PERLDB_FILE_ENABLED_$file_idx");
+        for my $line_idx (0 .. $#lines) {
+            _set_breakpoint_enabled_status(
+                $filename,
+                $lines[$line_idx],
+                ($enabled_statuses[$line_idx] ? 1 : ''),
+            );
+        }
     }
 
     # restore options
@@ -9144,6 +9157,13 @@ variable via C<DB::set_list>.
 
         # Save the list of all the breakpoints for this file.
         set_list( "PERLDB_FILE_$_", %dbline, @add );
+
+        # Serialize the extra data %breakpoints_data hash.
+        # That's a bug fix.
+        set_list( "PERLDB_FILE_ENABLED_$_", 
+            map { _is_breakpoint_enabled($file, $_) ? 1 : 0 }
+            sort { $a <=> $b } keys(%dbline)
+        )
     } ## end for (0 .. $#had_breakpoints)
 
     # The breakpoint was inside an eval. This is a little
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 36dbcb8..0adae25 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(16);
+plan(19);
 
 my $rc_filename = '.perldb';
 
@@ -98,6 +98,35 @@ like(_out_contents(), qr/sub factorial/,
 );
 
 {
+    my $target = '../lib/perl5db/t/eval-line-bug';
+
+    rc(
+        <<"EOF",
+    &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+    sub afterinit {
+        push(\@DB::typeahead,
+            'b 23',
+            'c',
+            '\$new_var = "Foo"',
+            'x "new_var = <\$new_var>\\n";',
+            'q',
+        );
+    }
+EOF
+    );
+
+    {
+        local $ENV{PERLDB_OPTS} = "ReadLine=0";
+        runperl(switches => [ '-d' ], progfile => $target);
+    }
+}
+
+like(_out_contents(), qr/new_var = <Foo>/,
+    "no strict 'vars' in evaluated lines.",
+);
+
+{
     local $ENV{PERLDB_OPTS} = "ReadLine=0";
     my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/lvalue-bug');
     like($output, qr/foo is defined/, 'lvalue subs work in the debugger');
@@ -355,6 +384,56 @@ EOF
         /msx,
         "Can set breakpoint in a line.");
 }
+
+# Testing that the prompt with the information appears.
+{
+    rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+    push (@DB::typeahead,
+    'q',
+    );
+
+}
+EOF
+
+    my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-1');
+
+    like(_out_contents(), qr/
+        ^main::\([^\)]*\bdisable-breakpoints-1:2\):\n
+        2:\s+my\ \$x\ =\ "One";\n
+        /msx,
+        "Prompt should display the first line of code.");
+}
+
+# Testing that R (restart) and "B *" work.
+{
+    rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+    push (@DB::typeahead,
+    'b 13',
+    'c',
+    'B *',
+    'b 9',
+    'R',
+    'c',
+    q/print "X={$x};dummy={$dummy}\n";/,
+    'q',
+    );
+
+}
+EOF
+
+    my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-1');
+    like($output, qr/
+        X=\{FirstVal\};dummy=\{1\}
+        /msx,
+        "Restart and delete all breakpoints work properly.");
+}
+
 END {
     1 while unlink ($rc_filename, $out_fn);
 }


-- 
-----------------------------------------------------------------
Shlomi Fish       http://www.shlomifish.org/
Funny Anti-Terrorism Story - http://shlom.in/enemy

Real programmers don’t write workarounds. They tell their users to upgrade
their software.

Please reply to list if it's a mailing list post - http://shlom.in/reply .

• [PATCH] perl -d bugfixes and tests - take 2 by Shlomi Fish
• Re: [PATCH] perl -d bugfixes and tests - take 2 by Father Chrysostomos