Fix RT#71678 (-d a command after exit) with a test.
authorShlomi Fish <shlomif@shlomifish.org>
Mon, 25 May 2015 17:56:23 +0000 (20:56 +0300)
committerTony Cook <tony@develop-help.com>
Wed, 3 Jun 2015 04:32:03 +0000 (14:32 +1000)
Credits to Heiko Eissfeldt for the reported bug, the test program and a
proposed fix.

MANIFEST
lib/perl5db.pl
lib/perl5db.t
lib/perl5db/t/test-a-statement-2 [new file with mode: 0644]

index 2586c3a..289e9f2 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4230,6 +4230,7 @@ lib/perl5db/t/source-cmd-test.perldb              Tests for the Perl debugger
 lib/perl5db/t/symbol-table-bug Tests for the Perl debugger
 lib/perl5db/t/taint            Tests for the Perl debugger
 lib/perl5db/t/test-a-statement-1       Tests for the Perl debugger
+lib/perl5db/t/test-a-statement-2       Tests for the Perl debugger
 lib/perl5db/t/test-dieLevel-option-1   Tests for the Perl debugger
 lib/perl5db/t/test-frame-option-1      Tests for the Perl debugger
 lib/perl5db/t/test-l-statement-1       Tests for the Perl debugger
index 7e7194e..0d240ae 100644 (file)
@@ -528,7 +528,7 @@ BEGIN {
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 use vars qw($VERSION $header);
 
-$VERSION = '1.49';
+$VERSION = '1.49_01';
 
 $header = "perl5db.pl version $VERSION";
 
@@ -3319,6 +3319,9 @@ B<h q>, B<h R> or B<h o> to get additional info.
 EOP
 
         # Set the DB::eval context appropriately.
+        # At program termination disable any user actions.
+        $DB::action = undef;
+
         $DB::package     = 'main';
         $DB::usercontext = DB::_calc_usercontext($DB::package);
     } ## end elsif ($package eq 'DB::fake')
index e93aee0..98a3686 100644 (file)
@@ -29,7 +29,7 @@ BEGIN {
     $ENV{PERL_RL} = 'Perl'; # Suppress system Term::ReadLine::Gnu
 }
 
-plan(120);
+plan(121);
 
 my $rc_filename = '.perldb';
 
@@ -2774,6 +2774,31 @@ SKIP:
     );
 }
 
+# [perl #71678] debugger bug in evaluation of user actions ('a' command)
+# Still evaluated after the script finishes.
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                q#a 9 print " \$arg = $arg\n"#,
+                'c 9',
+                's',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/test-a-statement-2',
+            switches => [ '-dw', ],
+            stderr => 1,
+        }
+    );
+
+    $wrapper->contents_unlike(qr/
+        Use\ of\ uninitialized\ value\ \$arg\ in\ concatenation\ [\S ]+\ or\ string\ at
+        /msx,
+        'Test that the a command does not emit warnings on program exit.',
+    );
+}
+
 END {
     1 while unlink ($rc_filename, $out_fn);
 }
diff --git a/lib/perl5db/t/test-a-statement-2 b/lib/perl5db/t/test-a-statement-2
new file mode 100644 (file)
index 0000000..0a3d304
--- /dev/null
@@ -0,0 +1,10 @@
+use strict; use warnings;
+
+greet('Hello');
+
+sub greet
+{
+    my $arg = shift;
+    print "$arg\n";
+    return;
+}