perl -d bugfixes and tests

This patch fixes some bugs in "perl -d" (see ticket #104820) and adds some regression tests (for the bugfixes and for better test coverage).
Perl · Dec 3, 2011 · bdba49a · bdba49a
1 parent 58b643a
commit bdba49a
Show file tree

Hide file tree

Showing 2 changed files with 103 additions and 4 deletions.
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
@@ -1098,6 +1098,9 @@ BEGIN
 # 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 @@ =head2 RESTART PROCESSING
 
     # 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 @@ sub restart {
 
         # 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
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(16);
+plan(19);
 
 my $rc_filename = '.perldb';
 
@@ -97,6 +97,35 @@ like(_out_contents(), qr/sub factorial/,
     'The ${main::_<filename} variable in the debugger was not destroyed'
 );
 
+{
+    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');
@@ -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);
 }