Deparse inverted for(;;) cond more correctly

[perl5.git] / lib / perl5db.t

diff --git a/lib/perl5db.t b/lib/perl5db.t
index 6ab4694..e93aee0 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(116);
+plan(120);
 
 my $rc_filename = '.perldb';
 
@@ -72,7 +72,7 @@ sub _out_contents
     rc(
         <<'EOF',
 
-&parse_options("NonStop=0 ReadLine=0 TTY=db.out LineInfo=db.out");
+&parse_options("NonStop=0 ReadLine=0 TTY=db.out");
 
 sub afterinit {
     push(@DB::typeahead,
@@ -92,36 +92,29 @@ EOF
 {
     local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
     my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-66110');
-    like($output, "All tests successful.", "[perl #66110]");
+    like($output, qr/\bAll tests successful\.$/, "[perl #66110]");
 }
 # [ perl #116769] Frame=2
 {
     local $ENV{PERLDB_OPTS} = "frame=2 nonstop";
-    my $output = runperl( switches => [ '-d' ], prog => 'print q{success}' );
+    my $output = runperl( switches => [ '-d' ], prog => 'print qq{success\n}' );
     is( $?, 0, '[perl #116769] frame=2 does not crash debugger, exit == 0' );
-    like( $output, 'success' , '[perl #116769] code is run' );
+    is( $output, "success\n" , '[perl #116769] code is run' );
 }
 # [ perl #116771] autotrace
 {
     local $ENV{PERLDB_OPTS} = "autotrace nonstop";
-    my $output = runperl( switches => [ '-d' ], prog => 'print q{success}' );
+    my $output = runperl( switches => [ '-d' ], prog => 'print qq{success\n}' );
     is( $?, 0, '[perl #116771] autotrace does not crash debugger, exit == 0' );
-    like( $output, 'success' , '[perl #116771] code is run' );
+    is( $output, "success\n" , '[perl #116771] code is run' );
 }
-
+# [ perl #41461] Frame=2 noTTY
 {
-    rc(<<'EOF');
-&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
-
-sub afterinit {
-    push (@DB::typeahead,
-    't 2',
-    'c',
-    'q',
-    );
-
-}
-EOF
+    local $ENV{PERLDB_OPTS} = "frame=2 noTTY nonstop";
+    rc('');
+    my $output = runperl( switches => [ '-d' ], prog => 'print qq{success\n}' );
+    is( $?, 0, '[perl #41461] frame=2 noTTY does not crash debugger, exit == 0' );
+    is( $output, "success\n" , '[perl #41461] code is run' );
 }
 
 package DebugWrap;
@@ -274,7 +267,7 @@ sub _quote
 sub _run {
     my $self = shift;
 
-    my $rc = qq{&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");\n};
+    my $rc = qq{&parse_options("NonStop=0 TTY=db.out");\n};
 
     $rc .= join('',
         map { "$_\n"}
@@ -1044,6 +1037,20 @@ sub _calc_trace_wrapper
     );
 }
 
+# Test for n with lvalue subs
+DebugWrap->new({
+    cmds =>
+    [
+        'n', 'print "<$x>\n"',
+        'n', 'print "<$x>\n"',
+        'q',
+    ],
+    prog => '../lib/perl5db/t/lsub-n',
+})->output_like(
+    qr/<1>\n<11>\n/,
+    'n steps over lvalue subs',
+);
+
 # Test for 'M' (module list).
 {
     my $wrapper = DebugWrap->new(
@@ -1228,6 +1235,7 @@ sub _calc_trace_wrapper
     $wrapper->contents_like(
         qr/
             $line_out
+            auto\(-\d+\)\s+DB<\d+>\s+\.\n
             $line_out
         /msx,
         'Test the "." command',
@@ -1497,10 +1505,11 @@ sub _calc_trace_wrapper
         }
     );
 
+    my $nl = $^O eq 'VMS' ? "" : "\\\n";
     $wrapper->output_like(qr#
-        \nVar<Q>=1\n
-        \nVar<Q>=2\n
-        \nVar<Q>=3\n
+        \nVar<Q>=1$nl
+        \nVar<Q>=2$nl
+        \nVar<Q>=3
         #msx,
         "a command is working",
     );
@@ -2270,7 +2279,7 @@ sub _calc_trace_wrapper
     );
 
     $wrapper->output_like(qr#
-        ^This\ program\ dies\.\ at\ \S+\ line\ 18\.\n
+        ^This\ program\ dies\.\ at\ \S+\ line\ 18\N*\.\n
         .*?
         ^\s+main::baz\(\)\ called\ at\ \S+\ line\ 13\n
         \s+main::bar\(\)\ called\ at\ \S+\ line\ 7\n
@@ -2295,7 +2304,7 @@ sub _calc_trace_wrapper
     );
 
     $wrapper->contents_like(qr#
-        ^This\ is\ not\ a\ warning\.\ at\ \S+\ line\ 18\.\n
+        ^This\ is\ not\ a\ warning\.\ at\ \S+\ line\ 18\N*\.\n
         .*?
         ^\s+main::baz\(\)\ called\ at\ \S+\ line\ 13\n
         \s+main::bar\(\)\ called\ at\ \S+\ line\ 25\n
@@ -2373,6 +2382,10 @@ sub _calc_trace_wrapper
     $wrapper->contents_like(qr/
         ^main::\([^:]+:28\):\n
         28:\s+myfunc\(\);\n
+        auto\(-\d+\)\s+DB<1>\s+t\n
+        Trace\ =\ on\n
+        auto\(-\d+\)\s+DB<1>\s+b\ 18\n
+        auto\(-\d+\)\s+DB<2>\s+c\n
         main::myfunc\([^:]+:25\):\n
         25:\s+bar\(\);\n
         /msx,
@@ -2400,10 +2413,14 @@ sub _calc_trace_wrapper
     $wrapper->contents_like(qr/
         ^main::\([^:]+:28\):\n
         28:\s+myfunc\(\);\n
+        auto\(-\d+\)\s+DB<1>\s+o\ AutoTrace\n
+        \s+AutoTrace\s+=\s+'1'\n
+        auto\(-\d+\)\s+DB<2>\s+b\ 18\n
+        auto\(-\d+\)\s+DB<3>\s+c\n
         main::myfunc\([^:]+:25\):\n
         25:\s+bar\(\);\n
         /msx,
-        'Test the t command with function calls.',
+        'Test the o AutoTrace command with function calls.',
     );
 }
 
@@ -2680,14 +2697,65 @@ sub _calc_trace_wrapper
     );
 }
 
+# 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:
 {
     $^O eq "linux"
         or skip "man errors aren't especially portable", 1;
+    -x '/usr/bin/man'
+        or skip "man command seems to be missing", 1;
     local $ENV{LANG} = "C";
-    local $ENV{LC_MESSAGE} = "C";
+    local $ENV{LC_MESSAGES} = "C";
     local $ENV{LC_ALL} = "C";
     my $wrapper = DebugWrap->new(
         {