From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Tue, 14 Nov 2006 16:59:45 +0000 (+0000)
Subject: A first regression test for the debugger, by Shlomi Fish
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=635f2c9e92f8c492655e9f22e378ee92d3368ced;p=p5sagit%2Fp5-mst-13.2.git

A first regression test for the debugger, by Shlomi Fish
and Richard Foley.

p4raw-id: //depot/perl@29274
---

diff --git a/MANIFEST b/MANIFEST
index 7326273..09186d0 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2104,6 +2104,8 @@ lib/Package/Constants/t/01_list.t	Package::Constants tests
 lib/Params/Check.pm	Params::Check
 lib/Params/Check/t/01_Params-Check.t	Params::Check tests
 lib/perl5db.pl			Perl debugging routines
+lib/perl5db.t			Tests for the Perl debugger
+lib/perl5db/eval-line-bug	Tests for the Perl debugger
 lib/PerlIO.pm			PerlIO support module
 lib/PerlIO/via/QuotedPrint.pm	PerlIO::via::QuotedPrint
 lib/PerlIO/via/t/QuotedPrint.t	PerlIO::via::QuotedPrint
diff --git a/lib/perl5db.t b/lib/perl5db.t
new file mode 100644
index 0000000..8735e87
--- /dev/null
+++ b/lib/perl5db.t
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use strict;
+use warnings;
+
+BEGIN {
+    if (!-c "/dev/null") {
+	print "1..0 # Skip: no /dev/null\n";
+	exit 0;
+    }
+}
+
+plan(1);
+
+sub rc {
+    open RC, ">", ".perldb" or die $!;
+    print RC @_;
+    close(RC);
+}
+
+rc(
+    qq|
+    &parse_options("NonStop=0 TTY=/dev/null LineInfo=db.out");
+    \n|,
+
+    qq|
+    sub afterinit {
+	push(\@DB::typeahead,
+	    "DB::print_lineinfo(\@{'main::_<perl5db/eval-line-bug'})",
+	    'b 23',
+	    'c',
+	    'q',
+	);
+    }\n|,
+);
+
+runperl(switches => [ '-d' ], progfile => '../lib/perl5db/eval-line-bug');
+
+my $contents;
+{
+    local $/;
+    open I, "<", 'db.out' or die $!;
+    $contents = <I>;
+    close(I);
+}
+
+like($contents, qr/factorial/,
+    'The ${main::_<filename} variable in the debugger was not destroyed'
+);
+
+# clean up.
+
+END {
+    unlink '.perldb', 'db.out';
+}
diff --git a/lib/perl5db/eval-line-bug b/lib/perl5db/eval-line-bug
new file mode 100644
index 0000000..cf6346e
--- /dev/null
+++ b/lib/perl5db/eval-line-bug
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+#
+# This code is used by lib/perl5db.t !!!
+#
+
+my $i = 5;
+eval "
+#line 5 script.pl
+\$i = 10;
+";
+
+for my $q (1 .. 10) {
+    $i += $q;
+}
+
+sub factorial
+{
+    my $i = shift;
+    return +($i < 2) ? 1 : $i*factorial($i-1);
+}
+
+my $j = 4;
+$j = factorial($j);
+$j = factorial(10);