Commit | Line | Data |
---|---|---|
af6d5e29 | 1 | #!./perl |
635f2c9e RGS |
2 | |
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
9 | use strict; | |
10 | use warnings; | |
f63574b5 | 11 | use Config; |
635f2c9e RGS |
12 | |
13 | BEGIN { | |
14 | if (!-c "/dev/null") { | |
15 | print "1..0 # Skip: no /dev/null\n"; | |
16 | exit 0; | |
17 | } | |
98274836 JM |
18 | my $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 | ||
07004ebb | 30 | plan(9); |
635f2c9e RGS |
31 | |
32 | sub 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 |
41 | my $target = '../lib/perl5db/t/eval-line-bug'; |
42 | ||
635f2c9e RGS |
43 | rc( |
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 | |
68 | my $contents; | |
69 | { | |
70 | local $/; | |
71 | open I, "<", 'db.out' or die $!; | |
72 | $contents = <I>; | |
73 | close(I); | |
74 | } | |
75 | ||
cd4eab35 | 76 | like($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 | 92 | SKIP: { |
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 | 102 | SKIP: { |
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 | ||
162 | ||
b7bfa855 B |
163 | # [perl #66110] Call a subroutine inside a regex |
164 | { | |
165 | local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1"; | |
166 | my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-66110'); | |
167 | like($output, "All tests successful.", "[perl #66110]"); | |
168 | } | |
169 | ||
07004ebb DM |
170 | # taint tests |
171 | ||
172 | { | |
173 | local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1"; | |
174 | my $output = runperl(switches => [ '-d', '-T' ], stderr => 1, | |
175 | progfile => '../lib/perl5db/t/taint'); | |
314655b3 | 176 | chomp $output if $^O eq 'VMS'; # newline guaranteed at EOF |
07004ebb DM |
177 | is($output, '[$^X][done]', "taint"); |
178 | } | |
179 | ||
b7bfa855 | 180 | |
635f2c9e RGS |
181 | # clean up. |
182 | ||
183 | END { | |
7cd48731 | 184 | 1 while unlink qw(.perldb db.out); |
635f2c9e | 185 | } |