[perl #121255] Call set-magic when setting $DB::sub

Otherwise UTF8 length caches will not be reset, resulting in panicks
when ${^UTF8CACHE} is -1 or wrongs answers from length($DB::sub) when
${^UTF8CACHE} is 1.

diff --git a/t/run/switchd.t b/t/run/switchd.t
index f901bf6..b5d4d42 100644 (file)
--- 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,25 @@ is(
   "ok\n",
   "setting breakpoints without *DB::dbline aliased"
 );
+
+# [perl #121255]
+# Check that utf8 caches are flushed when $DB::sub is set
+is(
+  runperl(
+   switches => [ '-Ilib', '-d:switchd_empty' ],
+   progs => [ split "\n",
+    'sub DB::sub{length($DB::sub); goto &$DB::sub}
+     ${^UTF8CACHE}=-1;
+     print
+       eval qq|sub oo\x{25f} { 42 }
+               sub ooooo\x{25f} { oo\x{25f}() }
+               ooooo\x{25f}()| 
+        || $@,
+       qq|\n|;
+    '
+   ],
+   stderr => 1
+  ),
+  "42\n",
+  'UTF8 length caches on $DB::sub are flushed'
+);

diff --git a/util.c b/util.c
index 6dc39f0..5541ac9 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5334,6 +5334,7 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
        (void)SvIOK_on(dbsv);
        SvIV_set(dbsv, PTR2IV(cv));     /* Do it the quickest way  */
     }
+    SvSETMAGIC(dbsv);
     TAINT_IF(save_taint);
 #ifdef NO_TAINT_SUPPORT
     PERL_UNUSED_VAR(save_taint);