diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-12-06 18:12:14 -0800 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-12-07 06:15:34 -0800 |
commit | b50b20584a1bbc1ab57f936301547125d5f4122b (patch) | |
tree | 682032fcac36c226fd9397e2486f9cecb75ed450 /op.c | |
parent | 0c9fdf2c6b80bede18dc1c30b17e9c1379e379d8 (diff) | |
download | perl-b50b20584a1bbc1ab57f936301547125d5f4122b.tar.gz |
Implement new ‘use 5.xxx' plan
• Version declarations now unload all features before loading the
specified feature bundle.
• Explicit use/no strict overrides any implicit strict-loading done by
version declarations, whether before or after use of strict.pm.
• ‘use 5.01’ or earlier disables any implicitly-enabled strictures.
Diffstat (limited to 'op.c')
-rw-r--r-- | op.c | 27 |
1 files changed, 24 insertions, 3 deletions
@@ -4669,6 +4669,14 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) newSTATEOP(0, NULL, imop) )); if (use_version) { + HV * const hinthv = GvHV(PL_hintgv); + + /* Turn features off */ + 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. */ use_version = sv_2mortal(new_version(use_version)); @@ -4677,14 +4685,27 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) { SV *const importsv = vnormal(use_version); *SvPVX_mutable(importsv) = ':'; - ENTER_with_name("load_feature"); Perl_load_module(aTHX_ 0, newSVpvs("feature"), NULL, importsv, NULL); - LEAVE_with_name("load_feature"); } + 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) { - PL_hints |= (HINT_STRICT_REFS | HINT_STRICT_SUBS | HINT_STRICT_VARS); + if (!hinthv || !hv_exists(hinthv, "strict/refs", 11)) + PL_hints |= HINT_STRICT_REFS; + if (!hinthv || !hv_exists(hinthv, "strict/subs", 11)) + PL_hints |= HINT_STRICT_SUBS; + if (!hinthv || !hv_exists(hinthv, "strict/vars", 11)) + PL_hints |= HINT_STRICT_VARS; + } + /* otherwise they are off */ + else { + if (!hinthv || !hv_exists(hinthv, "strict/refs", 11)) + PL_hints &= ~HINT_STRICT_REFS; + if (!hinthv || !hv_exists(hinthv, "strict/subs", 11)) + PL_hints &= ~HINT_STRICT_SUBS; + if (!hinthv || !hv_exists(hinthv, "strict/vars", 11)) + PL_hints &= ~HINT_STRICT_VARS; } } |