Remove constant.pm-specific behaviour from Internals::SvREADONLY

Some stuff on CPAN is using this undocumented function, so give
constant.pm its own.  It is already a core module, depending on
functionality provided by the core solely for its sake; so this
does not really change its relationship to the core.

diff --git a/dist/constant/lib/constant.pm b/dist/constant/lib/constant.pm
index d1353ee..f7d6bd9 100644 (file)
--- a/dist/constant/lib/constant.pm
+++ b/dist/constant/lib/constant.pm
@@ -27,7 +27,7 @@ BEGIN {
     # By doing this, we save 1 run time check for *every* call to import.
     my $const = $] > 5.009002;
     my $downgrade = $] < 5.015004; # && $] >= 5.008
-    my $constarray = $] >= 5.019003;
+    my $constarray = exists &_make_const;
     if ($const) {
        Internals::SvREADONLY($const, 1);
        Internals::SvREADONLY($downgrade, 1);
@@ -161,8 +161,8 @@ sub import {
            } elsif (@_) {
                my @list = @_;
                if (_CAN_PCS_FOR_ARRAY) {
-                   Internals::SvREADONLY($list[$_], 1) for 0..$#list;
-                   Internals::SvREADONLY(@list, 1);
+                   _make_const($list[$_]) for 0..$#list;
+                   _make_const(@list);
                    if ($symtab && !exists $symtab->{$name}) {
                        $symtab->{$name} = \@list;
                        $flush_mro++;

diff --git a/universal.c b/universal.c
index 969acbd..b217c14 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -940,15 +940,6 @@ XS(XS_Internals_SvREADONLY)        /* This is dangerous stuff. */
            if (SvIsCOW(sv)) sv_force_normal(sv);
 #endif
            SvREADONLY_on(sv);
-           if (SvTYPE(sv) == SVt_PVAV && AvFILLp(sv) != -1) {
-               /* for constant.pm; nobody else should be calling this
-                  on arrays anyway. */
-               SV **svp;
-               for (svp = AvARRAY(sv) + AvFILLp(sv)
-                  ; svp >= AvARRAY(sv)
-                  ; --svp)
-                   if (*svp) SvPADTMP_on(*svp);
-           }
            XSRETURN_YES;
        }
        else {
@@ -959,6 +950,37 @@ XS(XS_Internals_SvREADONLY)        /* This is dangerous stuff. */
     }
     XSRETURN_UNDEF; /* Can't happen. */
 }
+
+XS(XS_constant__make_const)    /* This is dangerous stuff. */
+{
+    dVAR;
+    dXSARGS;
+    SV * const svz = ST(0);
+    SV * sv;
+    PERL_UNUSED_ARG(cv);
+
+    /* [perl #77776] - called as &foo() not foo() */
+    if (!SvROK(svz) || items != 1)
+        croak_xs_usage(cv, "SCALAR");
+
+    sv = SvRV(svz);
+
+#ifdef PERL_OLD_COPY_ON_WRITE
+    if (SvIsCOW(sv)) sv_force_normal(sv);
+#endif
+    SvREADONLY_on(sv);
+    if (SvTYPE(sv) == SVt_PVAV && AvFILLp(sv) != -1) {
+       /* for constant.pm; nobody else should be calling this
+          on arrays anyway. */
+       SV **svp;
+       for (svp = AvARRAY(sv) + AvFILLp(sv)
+          ; svp >= AvARRAY(sv)
+          ; --svp)
+           if (*svp) SvPADTMP_on(*svp);
+    }
+    XSRETURN(0);
+}
+
 XS(XS_Internals_SvREFCNT)      /* This is dangerous stuff. */
 {
     dVAR;
@@ -1398,6 +1420,7 @@ static const struct xsub_details details[] = {
     {"utf8::native_to_unicode", XS_utf8_native_to_unicode, NULL},
     {"utf8::unicode_to_native", XS_utf8_unicode_to_native, NULL},
     {"Internals::SvREADONLY", XS_Internals_SvREADONLY, "\\[$%@];$"},
+    {"constant::_make_const", XS_constant__make_const, "\\[$@]"},
     {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"},
     {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"},
     {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@"},