Fix RT #121509 : perl -d handling chdir().

See: https://rt.perl.org/Ticket/Display.html?id=121509

    [perl #121509] perl debugger doesn't save starting dir to restart from

Thanks to Linda Walsh for reporting the problem and RJBS for commenting
for initial approval. Fix and a regression test by Shlomi Fish.

diff --git a/MANIFEST b/MANIFEST
index 226da01..dcf792a 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4107,6 +4107,7 @@ lib/perl5db/t/lvalue-bug  Tests for the Perl debugger
 lib/perl5db/t/MyModule.pm      Tests for the Perl debugger
 lib/perl5db/t/proxy-constants  Tests for the Perl debugger
 lib/perl5db/t/rt-104168                Tests for the Perl debugger
+lib/perl5db/t/rt-121509-restart-after-chdir            Tests for the Perl debugger
 lib/perl5db/t/rt-61222         Tests for the Perl debugger
 lib/perl5db/t/rt-66110         Tests for the Perl debugger
 lib/perl5db/t/source-cmd-test-no-q.perldb              Tests for the Perl debugger

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 8bc0150..e3f63b3 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -512,12 +512,17 @@ package DB;
 
 use strict;
 
+use Cwd ();
+
+my $_initial_cwd;
+
 BEGIN {eval 'use IO::Handle'}; # Needed for flush only? breaks under miniperl
 
 BEGIN {
     require feature;
     $^V =~ /^v(\d+\.\d+)/;
     feature->import(":$1");
+    $_initial_cwd = Cwd::getcwd();
 }
 
 # Debugger for Perl 5.00x; perl5db.pl patch level:
@@ -2260,6 +2265,13 @@ sub _DB__handle_restart_and_rerun_commands {
     # R - restart execution.
     # rerun - controlled restart execution.
     if ($cmd_cmd eq 'rerun' or $cmd_params eq '') {
+
+        # Change directory to the initial current working directory on
+        # the script startup, so if the debugged program changed the
+        # directory, then we will still be able to find the path to the
+        # the program. (perl 5 RT #121509 ).
+        chdir ($_initial_cwd);
+
         my @args = ($cmd_cmd eq 'R' ? restart() : rerun($cmd_params));
 
         # Close all non-system fds for a clean restart.  A more

diff --git a/lib/perl5db.t b/lib/perl5db.t
index 3af7f64..bd5615a 100644 (file)
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -29,7 +29,7 @@ BEGIN {
     $ENV{PERL_RL} = 'Perl'; # Suppress system Term::ReadLine::Gnu
 }
 
-plan(119);
+plan(120);
 
 my $rc_filename = '.perldb';
 
@@ -2697,6 +2697,55 @@ DebugWrap->new({
     );
 }
 
+# perl 5 RT #121509 regression bug.
+# “perl debugger doesn't save starting dir to restart from”
+# Thanks to Linda Walsh for reporting it.
+{
+    use File::Temp qw/tempdir/;
+
+    my $temp_dir = tempdir( CLEANUP => 1 );
+
+    local $ENV{__PERLDB_TEMP_DIR} = $temp_dir;
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                # This is to avoid getting the "Debugger program terminated"
+                # junk that interferes with the normal output.
+                'b _after_chdir',
+                'c',
+                'R',
+                'b _finale',
+                'c',
+                'n',
+                'n',
+                'n',
+                'n',
+                'n',
+                'n',
+                'n',
+                'n',
+                'n',
+                'n',
+                'n',
+                'n',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/rt-121509-restart-after-chdir',
+        }
+    );
+
+    $wrapper->output_like(
+        qr/
+In\ _finale\ No\ 1
+    .*?
+In\ _finale\ No\ 2
+    .*?
+In\ _finale\ No\ 3
+        /msx,
+        "Test that the debugger chdirs to the initial directory after a restart.",
+    );
+}
 # Test the perldoc command
 # We don't actually run the program, but we need to provide one to the wrapper.
 SKIP:

diff --git a/lib/perl5db/t/rt-121509-restart-after-chdir b/lib/perl5db/t/rt-121509-restart-after-chdir
new file mode 100644 (file)
index 0000000..f8250d7
--- /dev/null
+++ b/lib/perl5db/t/rt-121509-restart-after-chdir
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use IO::Handle;
+
+STDOUT->autoflush(1);
+
+my $tmpdir = $ENV{__PERLDB_TEMP_DIR};
+
+sub _do_chdir
+{
+    chdir($tmpdir);
+}
+
+sub _after_chdir
+{
+    print "_after_chdir\n";
+}
+
+sub _finale
+{
+    my $i = 1;
+    while (1)
+    {
+        print "In _finale No " . ($i++) . "\n";
+    }
+}
+
+_do_chdir();
+_after_chdir();
+_finale();