summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2013-10-28 21:59:14 -0700
committerFather Chrysostomos <sprout@cpan.org>2013-12-21 18:09:54 -0800
commitc1cec775e9019cc8ae244d4db239a7ea5c0b343e (patch)
treef2c2393343552b8a6e74bce1257e8770413d1839 /t
parentbb02e0c10a57ab28b9ec6ca218c7aa6aac53a90c (diff)
downloadperl-c1cec775e9019cc8ae244d4db239a7ea5c0b343e.tar.gz
[perl #119801] Stop @DB::dbline modifications from crashing
The cop address for each breakable line was being stored in the IVX slot of ${"_<$file"}[$line]. This value itself, writable from Perl space, was being used as the address of the op to be flagged, whenever a breakpoint was set. This meant writing to ${"_<$file"}[$line] and assigning a number (like 42) would cause perl to use 42 as an op address, and crash when trying to flag the op. Furthermore, since the array holding the lines could outlive the ops, setting a breakpoint on the op could write to freed memory or to an unrelated op (even a different type), potentially changing the beha- viour of unrelated code. This commit solves those pitfalls by moving breakpoints into a global breakpoint bitfield. Dbstate ops now have an extra field on the end holding a sequence number, representing which bit holds the breakpoint for that op.
Diffstat (limited to 't')
-rw-r--r--t/run/switchd.t19
1 files changed, 18 insertions, 1 deletions
diff --git a/t/run/switchd.t b/t/run/switchd.t
index f901bf620e..68a97d635c 100644
--- a/t/run/switchd.t
+++ b/t/run/switchd.t
@@ -9,7 +9,7 @@ BEGIN { require "./test.pl"; }
# This test depends on t/lib/Devel/switchd*.pm.
-plan(tests => 17);
+plan(tests => 18);
my $r;
@@ -253,3 +253,20 @@ is(
"ok\n",
"setting breakpoints without *DB::dbline aliased"
);
+
+# Test setting breakpoints after overwriting source lines
+is(
+ runperl(
+ switches => [ '-Ilib', '-d:switchd_empty' ],
+ progs => [ split "\n",
+ '*DB::dbline = *{q(_<).__FILE__};
+ $DB::dbline[1] = 7; # IVX used to point to the cop address
+ $DB::dbline{1} = 1; # crash accessing cCOPx(7)->op_flags
+ print qq[ok\n];
+ '
+ ],
+ stderr => 1
+ ),
+ "ok\n",
+ 'no crash when setting $DB::dbline{1} after $DB::dbline[1]'
+);