This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
switchd.t: correct bug number
[perl5.git] / t / run / switchd.t
CommitLineData
d7aa4417
JH
1#!./perl -w
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = qw(../lib lib);
6}
7
768fd157 8BEGIN { require "./test.pl"; }
d7aa4417 9
be1cc451 10# This test depends on t/lib/Devel/switchd*.pm.
964b4e64 11
4e917a04 12plan(tests => 11);
d7aa4417
JH
13
14my $r;
d7aa4417 15
2d90ac95 16my $filename = tempfile();
d7aa4417
JH
17SKIP: {
18 open my $f, ">$filename"
19 or skip( "Can't write temp file $filename: $!" );
20 print $f <<'__SWDTEST__';
21package Bar;
22sub bar { $_[0] * $_[0] }
23package Foo;
24sub foo {
25 my $s;
26 $s += Bar::bar($_) for 1..$_[0];
27}
28package main;
29Foo::foo(3);
30__SWDTEST__
31 close $f;
d7aa4417
JH
32 $| = 1; # Unbufferize.
33 $r = runperl(
e30fbb82 34 switches => [ '-Ilib', '-f', '-d:switchd' ],
d7aa4417 35 progfile => $filename,
964b4e64
JH
36 args => ['3'],
37 );
6e31dd88
JK
38 like($r,
39qr/^sub<Devel::switchd::import>;import<Devel::switchd>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
40 'Got debugging output: 1');
964b4e64 41 $r = runperl(
e30fbb82 42 switches => [ '-Ilib', '-f', '-d:switchd=a,42' ],
964b4e64
JH
43 progfile => $filename,
44 args => ['4'],
d7aa4417 45 );
6e31dd88
JK
46 like($r,
47qr/^sub<Devel::switchd::import>;import<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
48 'Got debugging output: 2');
b19934fb
NC
49 $r = runperl(
50 switches => [ '-Ilib', '-f', '-d:-switchd=a,42' ],
51 progfile => $filename,
52 args => ['4'],
53 );
6e31dd88
JK
54 like($r,
55qr/^sub<Devel::switchd::unimport>;unimport<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
56 'Got debugging output: 3');
d7aa4417
JH
57}
58
5a9a79a4
FC
59# [perl #71806]
60cmp_ok(
61 runperl( # less is useful for something :-)
62 switches => [ '"-Mless ++INC->{q-Devel/_.pm-}"' ],
63 progs => [
64 '#!perl -d:_',
65 'sub DB::DB{} print scalar @{q/_</.__FILE__}',
66 ],
67 ),
68 '>',
69 0,
70 'The debugger can see the lines of the main program under #!perl -d',
71);
be1cc451
FC
72
73# [perl #48332]
74like(
75 runperl(
76 switches => [ '-Ilib', '-d:switchd_empty' ],
77 progs => [
78 'sub foo { print qq _1\n_ }',
79 '*old_foo = \&foo;',
80 '*foo = sub { print qq _2\n_ };',
81 'old_foo(); foo();',
82 ],
83 ),
84 qr "1\r?\n2\r?\n",
85 'Subroutine redefinition works in the debugger [perl #48332]',
86);
a7999c08
FC
87
88# [rt.cpan.org #69862]
89like(
90 runperl(
91 switches => [ '-Ilib', '-d:switchd_empty' ],
92 progs => [
93 'sub DB::sub { goto &$DB::sub }',
94 'sub foo { print qq _1\n_ }',
95 'sub bar { print qq _2\n_ }',
96 'delete $::{foo}; eval { foo() };',
97 'my $bar = *bar; undef *bar; eval { &$bar };',
98 ],
99 ),
100 qr "1\r?\n2\r?\n",
101 'Subroutines no longer found under their names can be called',
102);
7d8b4ed3
FC
103
104# [rt.cpan.org #69862]
105like(
106 runperl(
107 switches => [ '-Ilib', '-d:switchd_empty' ],
108 progs => [
109 'sub DB::sub { goto &$DB::sub }',
110 'sub foo { goto &bar::baz; }',
111 'sub bar::baz { print qq _ok\n_ }',
112 'delete $::{bar::::};',
113 'foo();',
114 ],
115 ),
116 qr "ok\r?\n",
117 'No crash when calling orphaned subroutine via goto &',
118);
432d4561
JL
119
120# test when DB::DB is seen but not defined [perl #114990]
121like(
122 runperl(
123 switches => [ '-Ilib', '-d:nodb' ],
124 prog => [ '1' ],
125 stderr => 1,
126 ),
127 qr/^No DB::DB routine defined/,
c2cb6f77
FC
128 "No crash when *DB::DB exists but not &DB::DB",
129);
130like(
131 runperl(
132 switches => [ '-Ilib' ],
133 prog => 'sub DB::DB; BEGIN { $^P = 0x22; } for(0..9){ warn }',
134 stderr => 1,
135 ),
136 qr/^No DB::DB routine defined/,
137 "No crash when &DB::DB exists but isn't actually defined",
432d4561 138);
9d976ff5
FC
139
140# [perl #115742] Recursive DB::DB clobbering its own pad
141like(
142 runperl(
143 switches => [ '-Ilib' ],
144 progs => [ split "\n", <<'='
145 BEGIN {
146 $^P = 0x22;
147 }
148 package DB;
149 sub DB {
150 my $x = 42;
151 return if $__++;
152 $^D |= 1 << 30; # allow recursive calls
153 main::foo();
154 print $x//q-u-, qq-\n-;
155 }
156 package main;
157 chop;
158 sub foo { chop; }
159=
160 ],
161 stderr => 1,
162 ),
163 qr/42/,
164 "Recursive DB::DB does not clobber its own pad",
165);
4e917a04
FC
166
167# [perl #118627]
168like(
169 runperl(
170 switches => [ '-Ilib', '-d:switchd_empty' ],
171 prog => 'print @{q|_<-e|}',
172 ),
173 qr "use Devel::switchd_empty;(?:BEGIN|\r?\nprint)",
174 # miniperl tacks a BEGIN block on to the same line
7b6fb0b8 175 'Copy on write does not mangle ${"_<-e"}[0] [perl #118627]',
4e917a04 176);