diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2013-12-25 18:02:57 -0800 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2013-12-26 17:54:26 -0800 |
| commit | 2c6c1df5c2ddebe97be50ffbfbe1f5a2cf113eb1 (patch) | |
| tree | 655e3eebb7adbde2f11101723e7fb61f5d5e00dc /universal.c | |
| parent | 88df5f01a6650d6895e7d3f03d1b340ca2506b05 (diff) | |
| download | perl-2c6c1df5c2ddebe97be50ffbfbe1f5a2cf113eb1.tar.gz | |
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.
Diffstat (limited to 'universal.c')
| -rw-r--r-- | universal.c | 41 |
1 files changed, 32 insertions, 9 deletions
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, "*;@"}, |