diff options
| -rw-r--r-- | dist/constant/lib/constant.pm | 6 | ||||
| -rw-r--r-- | universal.c | 41 |
2 files changed, 35 insertions, 12 deletions
diff --git a/dist/constant/lib/constant.pm b/dist/constant/lib/constant.pm index d1353ee363..f7d6bd9d9e 100644 --- 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 969acbd03a..b217c14280 100644 --- 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, "*;@"}, |