Perl_magic_setbm() and Perl_magic_setfm() are mathoms that can be

merged with Perl_magic_setregexp(). [Coverage on the testsuite
suggests that more than that they're actually dead code, but in theory
it should be possible to construct a test case that exercises them.]

p4raw-id: //depot/perl@32789

diff --git a/embed.fnc b/embed.fnc
index 5819ad9..bba2c1b 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -459,11 +459,13 @@ p |int    |magic_set      |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setamagic|NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setarylen|NN SV* sv|NN MAGIC* mg
 p      |int    |magic_freearylen_p|NN SV* sv|NN MAGIC* mg
+#ifndef NO_MATHOMS
 p      |int    |magic_setbm    |NN SV* sv|NN MAGIC* mg
+p      |int    |magic_setfm    |NN SV* sv|NN MAGIC* mg
+#endif
 p      |int    |magic_setdbline|NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setdefelem|NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setenv   |NN SV* sv|NN MAGIC* mg
-p      |int    |magic_setfm    |NN SV* sv|NN MAGIC* mg
 dp     |int    |magic_sethint  |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setisa   |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setmglob |NN SV* sv|NN MAGIC* mg

diff --git a/embed.h b/embed.h
index 10e3ad0..942199a 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -431,11 +431,17 @@
 #define magic_setamagic                Perl_magic_setamagic
 #define magic_setarylen                Perl_magic_setarylen
 #define magic_freearylen_p     Perl_magic_freearylen_p
+#endif
+#ifndef NO_MATHOMS
+#ifdef PERL_CORE
 #define magic_setbm            Perl_magic_setbm
+#define magic_setfm            Perl_magic_setfm
+#endif
+#endif
+#ifdef PERL_CORE
 #define magic_setdbline                Perl_magic_setdbline
 #define magic_setdefelem       Perl_magic_setdefelem
 #define magic_setenv           Perl_magic_setenv
-#define magic_setfm            Perl_magic_setfm
 #define magic_sethint          Perl_magic_sethint
 #define magic_setisa           Perl_magic_setisa
 #define magic_setmglob         Perl_magic_setmglob
@@ -2727,11 +2733,17 @@
 #define magic_setamagic(a,b)   Perl_magic_setamagic(aTHX_ a,b)
 #define magic_setarylen(a,b)   Perl_magic_setarylen(aTHX_ a,b)
 #define magic_freearylen_p(a,b)        Perl_magic_freearylen_p(aTHX_ a,b)
+#endif
+#ifndef NO_MATHOMS
+#ifdef PERL_CORE
 #define magic_setbm(a,b)       Perl_magic_setbm(aTHX_ a,b)
+#define magic_setfm(a,b)       Perl_magic_setfm(aTHX_ a,b)
+#endif
+#endif
+#ifdef PERL_CORE
 #define magic_setdbline(a,b)   Perl_magic_setdbline(aTHX_ a,b)
 #define magic_setdefelem(a,b)  Perl_magic_setdefelem(aTHX_ a,b)
 #define magic_setenv(a,b)      Perl_magic_setenv(aTHX_ a,b)
-#define magic_setfm(a,b)       Perl_magic_setfm(aTHX_ a,b)
 #define magic_sethint(a,b)     Perl_magic_sethint(aTHX_ a,b)
 #define magic_setisa(a,b)      Perl_magic_setisa(aTHX_ a,b)
 #define magic_setmglob(a,b)    Perl_magic_setmglob(aTHX_ a,b)

diff --git a/mathoms.c b/mathoms.c
index 9e1c546..ff4a2a0 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -1338,6 +1338,18 @@ Perl_newHV(pTHX)
     return hv;
 }
 
+int
+Perl_magic_setbm(pTHX_ SV *sv, MAGIC *mg)
+{
+    return Perl_magic_setregexp(aTHX_ sv, mg);
+}
+
+int
+Perl_magic_setfm(pTHX_ SV *sv, MAGIC *mg)
+{
+    return Perl_magic_setregexp(aTHX_ sv, mg);
+}
+
 #endif /* NO_MATHOMS */
 
 /*

diff --git a/mg.c b/mg.c
index f341f23..2a1eefd 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2127,25 +2127,6 @@ Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg)
 }
 
 int
-Perl_magic_setbm(pTHX_ SV *sv, MAGIC *mg)
-{
-    PERL_UNUSED_ARG(mg);
-    sv_unmagic(sv, PERL_MAGIC_bm);
-    SvTAIL_off(sv);
-    SvVALID_off(sv);
-    return 0;
-}
-
-int
-Perl_magic_setfm(pTHX_ SV *sv, MAGIC *mg)
-{
-    PERL_UNUSED_ARG(mg);
-    sv_unmagic(sv, PERL_MAGIC_fm);
-    SvCOMPILED_off(sv);
-    return 0;
-}
-
-int
 Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
 {
     const struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
@@ -2158,9 +2139,16 @@ Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
 {
-    PERL_UNUSED_ARG(mg);
-    sv_unmagic(sv, PERL_MAGIC_qr);
-    return 0;
+    const char type = mg->mg_type;
+    if (type == PERL_MAGIC_qr) {
+    } else if (type == PERL_MAGIC_bm) {
+       SvTAIL_off(sv);
+       SvVALID_off(sv);
+    } else {
+       assert(type == PERL_MAGIC_fm);
+       SvCOMPILED_off(sv);
+    }
+    return sv_unmagic(sv, type);
 }
 
 int

diff --git a/perl.h b/perl.h
index a337a8c..48c7ab2 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -5024,7 +5024,7 @@ MGVTBL_SET(
 MGVTBL_SET(
     PL_vtbl_bm,
     0,
-    MEMBER_TO_FPTR(Perl_magic_setbm),
+    MEMBER_TO_FPTR(Perl_magic_setregexp),
     0,
     0,
     0,
@@ -5036,7 +5036,7 @@ MGVTBL_SET(
 MGVTBL_SET(
     PL_vtbl_fm,
     0,
-    MEMBER_TO_FPTR(Perl_magic_setfm),
+    MEMBER_TO_FPTR(Perl_magic_setregexp),
     0,
     0,
     0,

diff --git a/proto.h b/proto.h
index a845a9a..1cff3b3 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1198,23 +1198,25 @@ PERL_CALLCONV int       Perl_magic_freearylen_p(pTHX_ SV* sv, MAGIC* mg)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 
+#ifndef NO_MATHOMS
 PERL_CALLCONV int      Perl_magic_setbm(pTHX_ SV* sv, MAGIC* mg)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 
-PERL_CALLCONV int      Perl_magic_setdbline(pTHX_ SV* sv, MAGIC* mg)
+PERL_CALLCONV int      Perl_magic_setfm(pTHX_ SV* sv, MAGIC* mg)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 
-PERL_CALLCONV int      Perl_magic_setdefelem(pTHX_ SV* sv, MAGIC* mg)
+#endif
+PERL_CALLCONV int      Perl_magic_setdbline(pTHX_ SV* sv, MAGIC* mg)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 
-PERL_CALLCONV int      Perl_magic_setenv(pTHX_ SV* sv, MAGIC* mg)
+PERL_CALLCONV int      Perl_magic_setdefelem(pTHX_ SV* sv, MAGIC* mg)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 
-PERL_CALLCONV int      Perl_magic_setfm(pTHX_ SV* sv, MAGIC* mg)
+PERL_CALLCONV int      Perl_magic_setenv(pTHX_ SV* sv, MAGIC* mg)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);