develooper Front page | perl.perl5.porters | Postings from December 2011

[PATCH] perl -d bugfixes and tests

Thread Next
From:
Shlomi Fish
Date:
December 2, 2011 11:12
Subject:
[PATCH] perl -d bugfixes and tests
Message ID:
20111202210337.175390c7@lap.shlomifish.org
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

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..b4cab3f 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -1098,6 +1098,10 @@ $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.
+# Bug fix by Shlomi Fish.
+$trace_to_depth = 1;
+
 =head1 OPTION PROCESSING
 
 The debugger's options are actually spread out over the debugger itself and 
@@ -1567,9 +1571,20 @@ 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");
+        foreach my $line_idx (0 .. $#lines)
+        {
+            _set_breakpoint_enabled_status(
+                $filename,
+                $lines[$line_idx],
+                ($enabled_statuses[$line_idx] ? 1 : ''),
+            );
+        }
     }
 
     # restore options
@@ -9100,6 +9115,7 @@ just popped into environment variables directly.
     my @had_breakpoints = keys %had_breakpoints;
     set_list( "PERLDB_VISITED", @had_breakpoints );
 
+
     # Save the debugger options we chose.
     set_list( "PERLDB_OPT", %option );
     # set_list( "PERLDB_OPT", options2remember() );
@@ -9144,6 +9160,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 .

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About