This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fe392925df23ccdd454836359e2b5a85f6b18ccb
[perl5.git] / lib / perl5db.t
1 #!/usr/bin/perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 use strict;
10 use warnings;
11
12 BEGIN {
13     if (!-c "/dev/null") {
14         print "1..0 # Skip: no /dev/null\n";
15         exit 0;
16     }
17     if (!-c "/dev/tty") {
18         print "1..0 # Skip: no /dev/tty\n";
19         exit 0;
20     }
21 }
22
23 plan(1);
24
25 sub rc {
26     open RC, ">", ".perldb" or die $!;
27     print RC @_;
28     close(RC);
29     # overly permissive perms gives "Must not source insecure rcfile"
30     # and hangs at the DB(1> prompt
31     chmod 0644, ".perldb";
32 }
33
34 my $target = '../lib/perl5db/t/eval-line-bug';
35
36 rc(
37     qq|
38     &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
39     \n|,
40
41     qq|
42     sub afterinit {
43         push(\@DB::typeahead,
44             'b 23',
45             'n',
46             'n',
47             'n',
48             'c', # line 23
49             'n',
50             "p \\\@{'main::_<$target'}",
51             'q',
52         );
53     }\n|,
54 );
55
56 runperl(switches => [ '-d' ], progfile => $target);
57
58 my $contents;
59 {
60     local $/;
61     open I, "<", 'db.out' or die $!;
62     $contents = <I>;
63     close(I);
64 }
65
66 like($contents, qr/sub factorial/,
67     'The ${main::_<filename} variable in the debugger was not destroyed'
68 );
69
70 # clean up.
71
72 END {
73     unlink qw(.perldb db.out);
74 }