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

[perl #114644] [PATCH] Add more tests to the default perl debugger ("perl -d" , lib/perl5db.pl).

Thread Previous
From:
shlomif @ shlomifish . org
Date:
August 28, 2012 07:44
Subject:
[perl #114644] [PATCH] Add more tests to the default perl debugger ("perl -d" , lib/perl5db.pl).
Message ID:
rt-3.6.HEAD-11172-1346165076-1415.114644-75-0@perl.org
# New Ticket Created by  shlomif@shlomifish.org 
# Please include the string:  [perl #114644]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org:443/rt3/Ticket/Display.html?id=114644 >


Hi all,

I hope that those of you who went to the recent YAPC have enjoyed it.

This patch adds more tests for lib/perl5db.pl on lib/perl5db.t. One note is
that I'm a bit uncomfortable about the test for ".", which did not initially
work exactly as I expected, due to debugger quirks. If you don't want to add it,
let me know and I'll create a revised patch with that test excluded.

Regards,

	Shlomi Fish

diff --git a/MANIFEST b/MANIFEST
index 70b52d2..dad5191 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4327,6 +4327,7 @@ lib/perl5db/t/rt-66110		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-l-statement-1	Tests for the Perl debugger
+lib/perl5db/t/test-l-statement-2	Tests for the Perl debugger
 lib/perl5db/t/test-r-statement	Tests for the Perl debugger
 lib/perl5db/t/uncalled-subroutine	Tests for the Perl debugger
 lib/perl5db/t/with-subroutine		Tests for the Perl debugger
diff --git a/lib/perl5db.t b/lib/perl5db.t
index b6936b2..5128209 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(34);
+plan(37);
 
 my $rc_filename = '.perldb';
 
@@ -902,6 +902,125 @@ package main;
     );
 }
 
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l',
+                q/# After l 1/,
+                'l',
+                q/# After l 2/,
+                '-',
+                q/# After -/,
+                'q',
+            ],
+            prog => '../lib/perl5db/t/test-l-statement-1',
+        }
+    );
+
+    my $first_l_out = qr/
+        1==>\s+\$x\ =\ 1;\n
+        2:\s+print\ "1\\n";\n
+        3\s*\n
+        4:\s+\$x\ =\ 2;\n
+        5:\s+print\ "2\\n";\n
+        6\s*\n
+        7:\s+\$x\ =\ 3;\n
+        8:\s+print\ "3\\n";\n
+        9\s*\n
+        10:\s+\$x\ =\ 4;\n
+    /msx;
+
+    my $second_l_out = qr/
+        11:\s+print\ "4\\n";\n
+        12\s*\n
+        13:\s+\$x\ =\ 5;\n
+        14:\s+print\ "5\\n";\n
+        15\s*\n
+        16:\s+\$x\ =\ 6;\n
+        17:\s+print\ "6\\n";\n
+        18\s*\n
+        19:\s+\$x\ =\ 7;\n
+        20:\s+print\ "7\\n";\n
+    /msx;
+    $wrapper->contents_like(
+        qr/
+            ^$first_l_out
+            [^\n]*?DB<\d+>\ \#\ After\ l\ 1\n
+            [\ \t]*\n
+            [^\n]*?DB<\d+>\ l\s*\n
+            $second_l_out
+            [^\n]*?DB<\d+>\ \#\ After\ l\ 2\n
+            [\ \t]*\n
+            [^\n]*?DB<\d+>\ -\s*\n
+            $first_l_out
+            [^\n]*?DB<\d+>\ \#\ After\ -\n
+        /msx,
+        'l followed by l and then followed by -',
+    );
+}
+
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l fact',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/test-l-statement-2',
+        }
+    );
+
+    my $first_l_out = qr/
+        6\s+sub\ fact\ \{\n
+        7:\s+my\ \$n\ =\ shift;\n
+        8:\s+if\ \(\$n\ >\ 1\)\ \{\n
+        9:\s+return\ \$n\ \*\ fact\(\$n\ -\ 1\);
+    /msx;
+
+    $wrapper->contents_like(
+        qr/
+            DB<1>\s+l\ fact\n
+            $first_l_out
+        /msx,
+        'l subroutine_name',
+    );
+}
+
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'b fact',
+                'c',
+                # Repeat several times to avoid @typeahead problems.
+                '.',
+                '.',
+                '.',
+                '.',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/test-l-statement-2',
+        }
+    );
+
+    my $line_out = qr /
+        ^main::fact\([^\n]*?:7\):\n
+        ^7:\s+my\ \$n\ =\ shift;\n
+    /msx;
+
+    $wrapper->contents_like(
+        qr/
+            $line_out
+            $line_out
+        /msx,
+        'Test the "." command',
+    );
+}
+
 END {
     1 while unlink ($rc_filename, $out_fn);
 }
diff --git a/lib/perl5db/t/test-l-statement-1 b/lib/perl5db/t/test-l-statement-1
index c3cf5b0..990a169 100644
--- a/lib/perl5db/t/test-l-statement-1
+++ b/lib/perl5db/t/test-l-statement-1
@@ -6,3 +6,15 @@ print "2\n";
 
 $x = 3;
 print "3\n";
+
+$x = 4;
+print "4\n";
+
+$x = 5;
+print "5\n";
+
+$x = 6;
+print "6\n";
+
+$x = 7;
+print "7\n";
diff --git a/lib/perl5db/t/test-l-statement-2 b/lib/perl5db/t/test-l-statement-2
new file mode 100644
index 0000000..9e6a210
--- /dev/null
+++ b/lib/perl5db/t/test-l-statement-2
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+sub fact {
+    my $n = shift;
+    if ($n > 1) {
+        return $n * fact($n - 1);
+    } else {
+        return 1;
+    }
+}
+
+sub bar {
+    print "One\n";
+    print "Two\n";
+    print "Three\n";
+
+    return;
+}
+
+fact(5);
+bar();


Thread Previous


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