Commit | Line | Data |
---|---|---|
635f2c9e RGS |
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 | } | |
98274836 JM |
17 | my $dev_tty = '/dev/tty'; |
18 | $dev_tty = 'TT:' if ($^O eq 'VMS'); | |
19 | if (!-c $dev_tty) { | |
20 | print "1..0 # Skip: no $dev_tty\n"; | |
9366364f AT |
21 | exit 0; |
22 | } | |
b091e0d1 NC |
23 | if ($ENV{PERL5DB}) { |
24 | print "1..0 # Skip: \$ENV{PERL5DB} is already set to '$ENV{PERL5DB}'\n"; | |
25 | exit 0; | |
26 | } | |
635f2c9e RGS |
27 | } |
28 | ||
29 | plan(1); | |
30 | ||
31 | sub rc { | |
32 | open RC, ">", ".perldb" or die $!; | |
33 | print RC @_; | |
34 | close(RC); | |
3e5e55bd DM |
35 | # overly permissive perms gives "Must not source insecure rcfile" |
36 | # and hangs at the DB(1> prompt | |
37 | chmod 0644, ".perldb"; | |
635f2c9e RGS |
38 | } |
39 | ||
cd4eab35 RGS |
40 | my $target = '../lib/perl5db/t/eval-line-bug'; |
41 | ||
635f2c9e RGS |
42 | rc( |
43 | qq| | |
cd4eab35 | 44 | &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); |
635f2c9e RGS |
45 | \n|, |
46 | ||
47 | qq| | |
48 | sub afterinit { | |
49 | push(\@DB::typeahead, | |
635f2c9e | 50 | 'b 23', |
cd4eab35 RGS |
51 | 'n', |
52 | 'n', | |
53 | 'n', | |
54 | 'c', # line 23 | |
55 | 'n', | |
56 | "p \\\@{'main::_<$target'}", | |
635f2c9e RGS |
57 | 'q', |
58 | ); | |
59 | }\n|, | |
60 | ); | |
61 | ||
c18cf8ce SR |
62 | { |
63 | local $ENV{PERLDB_OPTS} = "ReadLine=0"; | |
64 | runperl(switches => [ '-d' ], progfile => $target); | |
65 | } | |
635f2c9e RGS |
66 | |
67 | my $contents; | |
68 | { | |
69 | local $/; | |
70 | open I, "<", 'db.out' or die $!; | |
71 | $contents = <I>; | |
72 | close(I); | |
73 | } | |
74 | ||
cd4eab35 | 75 | like($contents, qr/sub factorial/, |
635f2c9e RGS |
76 | 'The ${main::_<filename} variable in the debugger was not destroyed' |
77 | ); | |
78 | ||
79 | # clean up. | |
80 | ||
81 | END { | |
cd4eab35 | 82 | unlink qw(.perldb db.out); |
635f2c9e | 83 | } |