develooper Front page | perl.perl5.porters | Postings from September 2012

[perl #114756] [PATCH] [perl5db] Add more tests + Revert back to C-style for loops

From:
shlomif @ shlomifish . org
Date:
September 5, 2012 04:01
Subject:
[perl #114756] [PATCH] [perl5db] Add more tests + Revert back to C-style for loops
Message ID:
rt-3.6.HEAD-11172-1346842843-1521.114756-75-0@perl.org
# New Ticket Created by  shlomif@shlomifish.org 
# Please include the string:  [perl #114756]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org:443/rt3/Ticket/Display.html?id=114756 >


Hi all,

This patch to lib/perl5db.pl and lib/perl5db.t adds more tests for the L and S commands
and reverts some changes from C-style for loops to while+continue loops which were
not very popular.

Please look into applying it. It can also be found here:

https://github.com/shlomif/perl/tree/shlomif-perl-d-add-tests-take-4

(But with merge commits/etc., so it's not recommended).

Regards,

	Shlomi Fish

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 39c18e5..5b966e3 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -1756,7 +1756,7 @@ sub DB {
                 # If there's any call stack in place, turn off single
                 # stepping into subs throughout the stack.
             for my $i (0 .. $stack_depth) {
-                $stack[ $i++ ] &= ~1;
+                $stack[ $i ] &= ~1;
             }
 
             # And we are now no longer in single-step mode.
@@ -2002,9 +2002,7 @@ number information, and print that.
 
             # Scan forward, stopping at either the end or the next
             # unbreakable line.
-            {
-                my $i = $line + 1;
-                while ( $i <= $max && $dbline[$i] == 0 )
+            for ( my $i = $line + 1 ; $i <= $max && $dbline[$i] == 0 ; ++$i )
             {    #{ vi
 
                 # Drop out on null statements, block closers, and comments.
@@ -2029,12 +2027,7 @@ number information, and print that.
                 else {
                     depth_print_lineinfo($explicit_stop, $incr_pos);
                 }
-            }
-            continue
-            {
-                $i++;
-            }## end while ($i = $line + 1 ; $i...
-            }
+            } ## end for ($i = $line + 1 ; $i...
         } ## end else [ if ($slave_editor)
     } ## end if ($single || ($trace...
 
@@ -2965,15 +2958,10 @@ If a command is found, it is placed in C<$cmd> and executed via C<redo>.
                     pop(@hist) if length($cmd) > 1;
 
                     # Look backward through the history.
-                    $i = $#hist;
-                    while ($i) {
-
+                    for ( $i = $#hist ; $i ; --$i ) {
                         # Stop if we find it.
                         last if $hist[$i] =~ /$pat/;
                     }
-                    continue {
-                        $i--;
-                    }
 
                     if ( !$i ) {
 
@@ -3045,16 +3033,12 @@ Prints the contents of C<@hist> (if any).
                     # Start at the end of the array.
                     # Stay in while we're still above the ending value.
                     # Tick back by one each time around the loop.
-                    $i = $#hist;
-                    while ( $i > $end ) {
+                    for ( $i = $#hist ; $i > $end ; $i-- ) {
 
                         # Print the command  unless it has no arguments.
                         print $OUT "$i: ", $hist[$i], "\n"
                           unless $hist[$i] =~ /^.?$/;
                     }
-                    continue {
-                        $i--;
-                    }
                     next CMD;
                 };
 
@@ -5067,7 +5051,7 @@ sub cmd_l {
         # - whether a line has a break or not
         # - whether a line has an action or not
         else {
-            while ($i <= $end) {
+            for ( ; $i <= $end ; $i++ ) {
 
                 # Check for breakpoints and actions.
                 my ( $stop, $action );
@@ -5090,10 +5074,7 @@ sub cmd_l {
 
                 # Move on to the next line. Drop out on an interrupt.
                 $i++, last if $signal;
-            }
-            continue {
-                $i++;
-            }## end while (; $i <= $end ; $i++)
+            } ## end for (; $i <= $end ; $i++)
 
             # Line the prompt up; print a newline if the last line listed
             # didn't have a newline.
@@ -5854,11 +5835,11 @@ sub dump_trace {
     # number of stack frames, or we run out - caller() returns nothing - we
     # quit.
     # Up the stack frame index to go back one more level each time.
-    {
-        my $i = $skip;
-    while (
+    for (
+        my $i = $skip ;
         $i < $count
-        and ( $p, $file, $line, $sub, $h, $context, $e, $r ) = caller($i)
+        and ( $p, $file, $line, $sub, $h, $context, $e, $r ) = caller($i) ;
+        $i++
     )
     {
 
@@ -5945,11 +5926,7 @@ sub dump_trace {
 
         # Stop processing frames if the user hit control-C.
         last if $signal;
-    } ## end while ($i)
-    continue {
-        $i++;
-    }
-    }
+    } ## end for ($i = $skip ; $i < ...
 
     # Restore the trace value again.
     $trace = $otrace;
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 9276fad..f873a01 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(40);
+plan(48);
 
 my $rc_filename = '.perldb';
 
@@ -395,6 +395,13 @@ sub contents_like {
     ::like($self->_contents(), $re, $msg);
 }
 
+sub contents_unlike {
+    my ($self, $re, $msg) = @_;
+
+    local $::Level = $::Level + 1;
+    ::unlike($self->_contents(), $re, $msg);
+}
+
 package main;
 
 # Testing that we can set a line in the middle of the file.
@@ -1097,6 +1104,179 @@ package main;
     );
 }
 
+# Test the L command.
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'b 6',
+                'b 13 ($q == 5)',
+                'L',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/eval-line-bug',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr#
+        ^\S*?eval-line-bug:\n
+        \s*6:\s*my\ \$i\ =\ 5;\n
+        \s*break\ if\ \(1\)\n
+        \s*13:\s*\$i\ \+=\ \$q;\n
+        \s*break\ if\ \(\(\$q\ ==\ 5\)\)\n
+        #msx,
+        "L command is listing breakpoints",
+    );
+}
+
+# Test the L command for watch expressions.
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'w (5+6)',
+                'L',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/eval-line-bug',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr#
+        ^Watch-expressions:\n
+        \s*\(5\+6\)\n
+        #msx,
+        "L command is listing watch expressions",
+    );
+}
+
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'w (5+6)',
+                'w (11*23)',
+                'W (5+6)',
+                'L',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/eval-line-bug',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr#
+        ^Watch-expressions:\n
+        \s*\(11\*23\)\n
+        ^auto\(
+        #msx,
+        "L command is not listing deleted watch expressions",
+    );
+}
+
+# Test the L command.
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'b 6',
+                'a 13 print $i',
+                'L',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/eval-line-bug',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr#
+        ^\S*?eval-line-bug:\n
+        \s*6:\s*my\ \$i\ =\ 5;\n
+        \s*break\ if\ \(1\)\n
+        \s*13:\s*\$i\ \+=\ \$q;\n
+        \s*action:\s+print\ \$i\n
+        #msx,
+        "L command is listing actions and breakpoints",
+    );
+}
+
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'S',
+                'q',
+            ],
+            prog =>  '../lib/perl5db/t/rt-104168',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr#
+        ^main::bar\n
+        main::baz\n
+        main::foo\n
+        #msx,
+        "S command - 1",
+    );
+}
+
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'S ^main::ba',
+                'q',
+            ],
+            prog =>  '../lib/perl5db/t/rt-104168',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr#
+        ^main::bar\n
+        main::baz\n
+        auto\(
+        #msx,
+        "S command with regex",
+    );
+}
+
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'S !^main::ba',
+                'q',
+            ],
+            prog =>  '../lib/perl5db/t/rt-104168',
+        }
+    );
+
+    $wrapper->contents_unlike(
+        qr#
+        ^main::ba
+        #msx,
+        "S command with negative regex",
+    );
+
+    $wrapper->contents_like(
+        qr#
+        ^main::foo\n
+        #msx,
+        "S command with negative regex - what it still matches",
+    );
+}
+
 END {
     1 while unlink ($rc_filename, $out_fn);
 }


-- 
-----------------------------------------------------------------
Shlomi Fish       http://www.shlomifish.org/
Interview with Ben Collins-Sussman - http://shlom.in/sussman

Learn Perl from “Learning Perl in 24 Minutes Unleashed, in a Nutshell for
Dummies.”
    — based on Shlomi Fish and f00li5h on #perl

Please reply to list if it's a mailing list post - http://shlom.in/reply .




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