This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
revert recent changes to eintr.t
[perl5.git] / lib / perl5db.t
CommitLineData
af6d5e29 1#!./perl
635f2c9e
RGS
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8
9use strict;
10use warnings;
f63574b5 11use Config;
635f2c9e
RGS
12
13BEGIN {
14 if (!-c "/dev/null") {
15 print "1..0 # Skip: no /dev/null\n";
16 exit 0;
17 }
98274836
JM
18my $dev_tty = '/dev/tty';
19 $dev_tty = 'TT:' if ($^O eq 'VMS');
20 if (!-c $dev_tty) {
21 print "1..0 # Skip: no $dev_tty\n";
9366364f
AT
22 exit 0;
23 }
b091e0d1
NC
24 if ($ENV{PERL5DB}) {
25 print "1..0 # Skip: \$ENV{PERL5DB} is already set to '$ENV{PERL5DB}'\n";
26 exit 0;
27 }
635f2c9e
RGS
28}
29
076b743f 30plan(11);
635f2c9e
RGS
31
32sub rc {
33 open RC, ">", ".perldb" or die $!;
34 print RC @_;
35 close(RC);
3e5e55bd
DM
36 # overly permissive perms gives "Must not source insecure rcfile"
37 # and hangs at the DB(1> prompt
38 chmod 0644, ".perldb";
635f2c9e
RGS
39}
40
cd4eab35
RGS
41my $target = '../lib/perl5db/t/eval-line-bug';
42
635f2c9e
RGS
43rc(
44 qq|
cd4eab35 45 &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
635f2c9e
RGS
46 \n|,
47
48 qq|
49 sub afterinit {
50 push(\@DB::typeahead,
635f2c9e 51 'b 23',
cd4eab35
RGS
52 'n',
53 'n',
54 'n',
55 'c', # line 23
56 'n',
57 "p \\\@{'main::_<$target'}",
635f2c9e
RGS
58 'q',
59 );
60 }\n|,
61);
62
c18cf8ce
SR
63{
64 local $ENV{PERLDB_OPTS} = "ReadLine=0";
65 runperl(switches => [ '-d' ], progfile => $target);
66}
635f2c9e
RGS
67
68my $contents;
69{
70 local $/;
71 open I, "<", 'db.out' or die $!;
72 $contents = <I>;
73 close(I);
74}
75
cd4eab35 76like($contents, qr/sub factorial/,
635f2c9e
RGS
77 'The ${main::_<filename} variable in the debugger was not destroyed'
78);
79
1ad62f64 80{
6fd69bbe 81 local $ENV{PERLDB_OPTS} = "ReadLine=0";
6fd69bbe
FR
82 my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/lvalue-bug');
83 like($output, qr/foo is defined/, 'lvalue subs work in the debugger');
84}
85
bc6438f2
DL
86{
87 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
88 my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/symbol-table-bug');
89 like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table');
90}
91
9b76ae71 92SKIP: {
f63574b5 93 if ( $Config{usethreads} ) {
9c955c4d
DL
94 skip('This perl has threads, skipping non-threaded debugger tests');
95 } else {
96 my $error = 'This Perl not built to support threads';
53409900 97 my $output = runperl( switches => [ '-dt' ], stderr => 1 );
9c955c4d
DL
98 like($output, qr/$error/, 'Perl debugger correctly complains that it was not built with threads');
99 }
100
101}
9b76ae71 102SKIP: {
9c955c4d 103 if ( $Config{usethreads} ) {
f63574b5
DL
104 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
105 my $output = runperl(switches => [ '-dt' ], progfile => '../lib/perl5db/t/symbol-table-bug');
106 like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table when running with thread support');
107 } else {
108 skip("This perl is not threaded, skipping threaded debugger tests");
109 }
7dcc656f
DL
110}
111
7eedc5ec
B
112
113# Test [perl #61222]
114{
115 rc(
116 qq|
117 &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
118 \n|,
119
120 qq|
121 sub afterinit {
122 push(\@DB::typeahead,
123 'm Pie',
124 'q',
125 );
126 }\n|,
127 );
128
129 my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-61222');
130 my $contents;
131 {
132 local $/;
133 open I, "<", 'db.out' or die $!;
134 $contents = <I>;
135 close(I);
136 }
137 unlike($contents, qr/INCORRECT/, "[perl #61222]");
138}
139
140
141
142# Test for Proxy constants
143{
144 rc(
145 qq|
5dec12c4 146 &parse_options("NonStop=0 ReadLine=0 TTY=db.out LineInfo=db.out");
7eedc5ec
B
147 \n|,
148
149 qq|
150 sub afterinit {
151 push(\@DB::typeahead,
152 'm main->s1',
153 'q',
154 );
155 }\n|,
156 );
157
158 my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/proxy-constants');
159 is($output, "", "proxy constant subroutines");
160}
161
076b743f
SF
162# Testing that we can set a line in the middle of the file.
163{
164 rc(<<'EOF');
165&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
166
167sub afterinit {
168 push (@DB::typeahead,
169 'b ../lib/perl5db/t/MyModule.pm:12',
170 'c',
171 q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
172 'c',
173 'q',
174 );
175
176}
177EOF
178
179 my $output = runperl(switches => [ '-d', '-I', '../lib/perl5db/t', ], stderr => 1, progfile => '../lib/perl5db/t/filename-line-breakpoint');
180
181 like($output, qr/
182 ^Var=Bar$
183 .*
184 ^In\ MyModule\.$
185 .*
186 ^In\ Main\ File\.$
187 .*
188 /msx,
189 "Can set breakpoint in a line in the middle of the file.");
190}
191
7eedc5ec 192
b7bfa855
B
193# [perl #66110] Call a subroutine inside a regex
194{
195 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
196 my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-66110');
197 like($output, "All tests successful.", "[perl #66110]");
198}
199
07004ebb
DM
200# taint tests
201
202{
203 local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
204 my $output = runperl(switches => [ '-d', '-T' ], stderr => 1,
205 progfile => '../lib/perl5db/t/taint');
314655b3 206 chomp $output if $^O eq 'VMS'; # newline guaranteed at EOF
07004ebb
DM
207 is($output, '[$^X][done]', "taint");
208}
209
2211a10b
SF
210# Testing that we can set a breakpoint
211{
212 rc(<<'EOF');
213&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
214
215sub afterinit {
216 push (@DB::typeahead,
217 'b 6',
218 'c',
219 q/do { use IO::Handle; STDOUT->autoflush(1); print "X={$x}\n"; }/,
220 'c',
221 'q',
222 );
223
224}
225EOF
226
227 my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/breakpoint-bug');
228
229 like($output, qr/
230 X=\{Two\}
231 /msx,
232 "Can set breakpoint in a line.");
233}
234
235
b7bfa855 236
635f2c9e
RGS
237# clean up.
238
239END {
7cd48731 240 1 while unlink qw(.perldb db.out);
635f2c9e 241}