This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlre: Fix syntax error in example
[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
c2cb6f77 12plan(tests => 9);
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 );
eae48c89 38 like($r, qr/^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>;$/);
964b4e64 39 $r = runperl(
e30fbb82 40 switches => [ '-Ilib', '-f', '-d:switchd=a,42' ],
964b4e64
JH
41 progfile => $filename,
42 args => ['4'],
d7aa4417 43 );
eae48c89 44 like($r, qr/^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>;$/);
b19934fb
NC
45 $r = runperl(
46 switches => [ '-Ilib', '-f', '-d:-switchd=a,42' ],
47 progfile => $filename,
48 args => ['4'],
49 );
50 like($r, qr/^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>;$/);
d7aa4417
JH
51}
52
5a9a79a4
FC
53# [perl #71806]
54cmp_ok(
55 runperl( # less is useful for something :-)
56 switches => [ '"-Mless ++INC->{q-Devel/_.pm-}"' ],
57 progs => [
58 '#!perl -d:_',
59 'sub DB::DB{} print scalar @{q/_</.__FILE__}',
60 ],
61 ),
62 '>',
63 0,
64 'The debugger can see the lines of the main program under #!perl -d',
65);
be1cc451
FC
66
67# [perl #48332]
68like(
69 runperl(
70 switches => [ '-Ilib', '-d:switchd_empty' ],
71 progs => [
72 'sub foo { print qq _1\n_ }',
73 '*old_foo = \&foo;',
74 '*foo = sub { print qq _2\n_ };',
75 'old_foo(); foo();',
76 ],
77 ),
78 qr "1\r?\n2\r?\n",
79 'Subroutine redefinition works in the debugger [perl #48332]',
80);
a7999c08
FC
81
82# [rt.cpan.org #69862]
83like(
84 runperl(
85 switches => [ '-Ilib', '-d:switchd_empty' ],
86 progs => [
87 'sub DB::sub { goto &$DB::sub }',
88 'sub foo { print qq _1\n_ }',
89 'sub bar { print qq _2\n_ }',
90 'delete $::{foo}; eval { foo() };',
91 'my $bar = *bar; undef *bar; eval { &$bar };',
92 ],
93 ),
94 qr "1\r?\n2\r?\n",
95 'Subroutines no longer found under their names can be called',
96);
7d8b4ed3
FC
97
98# [rt.cpan.org #69862]
99like(
100 runperl(
101 switches => [ '-Ilib', '-d:switchd_empty' ],
102 progs => [
103 'sub DB::sub { goto &$DB::sub }',
104 'sub foo { goto &bar::baz; }',
105 'sub bar::baz { print qq _ok\n_ }',
106 'delete $::{bar::::};',
107 'foo();',
108 ],
109 ),
110 qr "ok\r?\n",
111 'No crash when calling orphaned subroutine via goto &',
112);
432d4561
JL
113
114# test when DB::DB is seen but not defined [perl #114990]
115like(
116 runperl(
117 switches => [ '-Ilib', '-d:nodb' ],
118 prog => [ '1' ],
119 stderr => 1,
120 ),
121 qr/^No DB::DB routine defined/,
c2cb6f77
FC
122 "No crash when *DB::DB exists but not &DB::DB",
123);
124like(
125 runperl(
126 switches => [ '-Ilib' ],
127 prog => 'sub DB::DB; BEGIN { $^P = 0x22; } for(0..9){ warn }',
128 stderr => 1,
129 ),
130 qr/^No DB::DB routine defined/,
131 "No crash when &DB::DB exists but isn't actually defined",
432d4561 132);