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