From 7d69d4a61be1619f90910462eac42234c874712e Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Thu, 15 Dec 2011 16:26:16 -0800 Subject: Disable $[ under 5.16 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This adds the array_base feature to feature.pm Perl_feature_is_enabled has been modified to use PL_curcop, rather than PL_hintgv, so it can work with run-time hints as well. (PL_curcop holds the current state op at run time, and &PL_compiling at compile time, so it works for both.) The hints in $^H are not stored in the same place at compile time and run time, so the FEATURE_IS_ENABLED macro has been modified to check first whether PL_curop == &PL_compiling. Since array_base is on by default with no hint for it in %^H, it is a ‘negative’ feature, whose entry in %^H turns it off. feature.pm has been modified to support such negative features. The new FEATURE_IS_ENABLED_d can check whether such default features are enabled. This does make things less efficient, as every version declaration now loads feature.pm to disable all features (including turning off array_base, which entails adding an entry to %^H) before loading the new bundle. I have plans to make this more efficient. --- op.c | 21 ++++++++------------- 1 file changed, 8 insertions(+), 13 deletions(-) (limited to 'op.c') diff --git a/op.c b/op.c index 313087d34a..812ece2bb1 100644 --- a/op.c +++ b/op.c @@ -4672,17 +4672,13 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) if (use_version) { HV * const hinthv = GvHV(PL_hintgv); const bool hhoff = !hinthv || !(PL_hints & HINT_LOCALIZE_HH); + SV *importsv; /* Turn features off */ - if (hhoff) - /* avoid loading feature.pm */ - PL_hints &= ~HINT_UNI_8_BIT; - else { - ENTER_with_name("load_feature"); - Perl_load_module(aTHX_ + ENTER_with_name("load_feature"); + Perl_load_module(aTHX_ PERL_LOADMOD_DENY, newSVpvs("feature"), NULL, NULL - ); - } + ); /* If we request a version >= 5.9.5, load feature.pm with the * feature bundle that corresponds to the required version. */ @@ -4690,13 +4686,12 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) if (vcmp(use_version, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) { - SV *const importsv = vnormal(use_version); - if (hhoff) ENTER_with_name("load_feature"); + importsv = vnormal(use_version); *SvPVX_mutable(importsv) = ':'; - Perl_load_module(aTHX_ 0, newSVpvs("feature"), NULL, importsv, NULL); - LEAVE_with_name("load_feature"); } - else if (!hhoff) LEAVE_with_name("load_feature"); + else importsv = newSVpvs(":default"); + Perl_load_module(aTHX_ 0, newSVpvs("feature"), NULL, importsv, NULL); + LEAVE_with_name("load_feature"); /* If a version >= 5.11.0 is requested, strictures are on by default! */ if (vcmp(use_version, sv_2mortal(upg_version(newSVnv(5.011000), FALSE))) >= 0) { -- cgit v1.2.1