1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
#!./perl -w
BEGIN {
chdir 't' if -d 't';
@INC = qw(../lib lib);
}
BEGIN { require "./test.pl"; }
# This test depends on t/lib/Devel/switchd*.pm.
plan(tests => 7);
my $r;
my $filename = tempfile();
SKIP: {
open my $f, ">$filename"
or skip( "Can't write temp file $filename: $!" );
print $f <<'__SWDTEST__';
package Bar;
sub bar { $_[0] * $_[0] }
package Foo;
sub foo {
my $s;
$s += Bar::bar($_) for 1..$_[0];
}
package main;
Foo::foo(3);
__SWDTEST__
close $f;
$| = 1; # Unbufferize.
$r = runperl(
switches => [ '-Ilib', '-f', '-d:switchd' ],
progfile => $filename,
args => ['3'],
);
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>;$/);
$r = runperl(
switches => [ '-Ilib', '-f', '-d:switchd=a,42' ],
progfile => $filename,
args => ['4'],
);
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>;$/);
$r = runperl(
switches => [ '-Ilib', '-f', '-d:-switchd=a,42' ],
progfile => $filename,
args => ['4'],
);
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>;$/);
}
# [perl #71806]
cmp_ok(
runperl( # less is useful for something :-)
switches => [ '"-Mless ++INC->{q-Devel/_.pm-}"' ],
progs => [
'#!perl -d:_',
'sub DB::DB{} print scalar @{q/_</.__FILE__}',
],
),
'>',
0,
'The debugger can see the lines of the main program under #!perl -d',
);
# [perl #48332]
like(
runperl(
switches => [ '-Ilib', '-d:switchd_empty' ],
progs => [
'sub foo { print qq _1\n_ }',
'*old_foo = \&foo;',
'*foo = sub { print qq _2\n_ };',
'old_foo(); foo();',
],
),
qr "1\r?\n2\r?\n",
'Subroutine redefinition works in the debugger [perl #48332]',
);
# [rt.cpan.org #69862]
like(
runperl(
switches => [ '-Ilib', '-d:switchd_empty' ],
progs => [
'sub DB::sub { goto &$DB::sub }',
'sub foo { print qq _1\n_ }',
'sub bar { print qq _2\n_ }',
'delete $::{foo}; eval { foo() };',
'my $bar = *bar; undef *bar; eval { &$bar };',
],
),
qr "1\r?\n2\r?\n",
'Subroutines no longer found under their names can be called',
);
# [rt.cpan.org #69862]
like(
runperl(
switches => [ '-Ilib', '-d:switchd_empty' ],
progs => [
'sub DB::sub { goto &$DB::sub }',
'sub foo { goto &bar::baz; }',
'sub bar::baz { print qq _ok\n_ }',
'delete $::{bar::::};',
'foo();',
],
),
qr "ok\r?\n",
'No crash when calling orphaned subroutine via goto &',
);
|
