In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3ab64bae9b914de9eb939a6995f6ef94385e1221?hp=88df5f01a6650d6895e7d3f03d1b340ca2506b05>
- Log ----------------------------------------------------------------- commit 3ab64bae9b914de9eb939a6995f6ef94385e1221 Author: Father Chrysostomos <[email protected]> Date: Wed Dec 25 18:03:16 2013 -0800 Increase $constant::VERSION to 1.31 M dist/constant/lib/constant.pm commit 2c6c1df5c2ddebe97be50ffbfbe1f5a2cf113eb1 Author: Father Chrysostomos <[email protected]> Date: Wed Dec 25 18:02:57 2013 -0800 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. M dist/constant/lib/constant.pm M universal.c ----------------------------------------------------------------------- Summary of changes: dist/constant/lib/constant.pm | 8 ++++---- universal.c | 41 ++++++++++++++++++++++++++++++++--------- 2 files changed, 36 insertions(+), 13 deletions(-) diff --git a/dist/constant/lib/constant.pm b/dist/constant/lib/constant.pm index d1353ee..5d0d547 100644 --- a/dist/constant/lib/constant.pm +++ b/dist/constant/lib/constant.pm @@ -4,7 +4,7 @@ use strict; use warnings::register; use vars qw($VERSION %declared); -$VERSION = '1.30'; +$VERSION = '1.31'; #======================================================================= @@ -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 --- 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, "*;@"}, -- Perl5 Master Repository
