From 88e9444c4ef58850472b05bba333f4072222d0da Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Thu, 25 Nov 2010 17:08:18 +0000 Subject: [PATCH] Make BEGIN {require 5.12.0} behave as documented. Previously in a BEGIN block, require was behaving identically to use 5.12.0 - ie erroneously executing the use feature ':5.12.0'; and use strict; use warnings behaviour, which only use was documented to provide. --- op.c | 25 ++++++++++++++++++++++++- pod/perldelta.pod | 6 +++++- pp_ctl.c | 17 ----------------- t/comp/require.t | 5 ++++- t/op/override.t | 8 ++++---- 5 files changed, 37 insertions(+), 24 deletions(-) diff --git a/op.c b/op.c index 73f5f4a..2115c66 100644 --- a/op.c +++ b/op.c @@ -4222,6 +4222,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) #ifdef PERL_MAD OP *pegop = newOP(OP_NULL,0); #endif + SV *use_version = NULL; PERL_ARGS_ASSERT_UTILIZE; @@ -4268,7 +4269,9 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) } else if (SvNIOKp(((SVOP*)idop)->op_sv)) { imop = NULL; /* use 5.0; */ - if (!aver) + if (aver) + use_version = ((SVOP*)idop)->op_sv; + else idop->op_private |= OPpCONST_NOVER; } else { @@ -4300,6 +4303,26 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) newSTATEOP(0, NULL, veop)), newSTATEOP(0, NULL, imop) )); + if (use_version) { + /* 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)); + + if (vcmp(use_version, + 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"); + } + /* 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); + } + } + /* The "did you use incorrect case?" warning used to be here. * The problem is that on case-insensitive filesystems one * might get false positives for "use" (and "require"): diff --git a/pod/perldelta.pod b/pod/perldelta.pod index f269ac3..1738a47 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -356,7 +356,11 @@ L. =item * -XXX +C now behaves as documented, rather than behaving +identically to C. Previously, C in a C block +was erroneously executing the C and +C behaviour, which only C was documented to +provide. =back diff --git a/pp_ctl.c b/pp_ctl.c index 54e7c25..3629c93 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3465,23 +3465,6 @@ PP(pp_require) } } - /* We do this only with "use", not "require" or "no". */ - if (PL_compcv && !(cUNOP->op_first->op_private & OPpCONST_NOVER)) { - /* If we request a version >= 5.9.5, load feature.pm with the - * feature bundle that corresponds to the required version. */ - if (vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) { - SV *const importsv = vnormal(sv); - *SvPVX_mutable(importsv) = ':'; - ENTER_with_name("load_feature"); - 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(sv, sv_2mortal(upg_version(newSVnv(5.011000), FALSE))) >= 0) { - PL_hints |= (HINT_STRICT_REFS | HINT_STRICT_SUBS | HINT_STRICT_VARS); - } - } - RETPUSHYES; } name = SvPV_const(sv, len); diff --git a/t/comp/require.t b/t/comp/require.t index 988a102..d4ca56c 100644 --- a/t/comp/require.t +++ b/t/comp/require.t @@ -22,7 +22,7 @@ krunch.pm krunch.pmc whap.pm whap.pmc); my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0; my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/; -my $total_tests = 49; +my $total_tests = 50; if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= 3; } print "1..$total_tests\n"; @@ -98,6 +98,9 @@ print "ok ",$i++,"\n"; eval 'require 5.11.0; ${"foo"} = "bar";'; print "# $@\nnot " if $@; print "ok ",$i++,"\n"; +eval 'BEGIN {require 5.11.0} ${"foo"} = "bar";'; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; # interaction with pod (see the eof) write_file('bleah.pm', "print 'ok $i\n'; 1;\n"); diff --git a/t/op/override.t b/t/op/override.t index 60d772b..e80cf61 100644 --- a/t/op/override.t +++ b/t/op/override.t @@ -37,8 +37,8 @@ is( $r, join($dirsep, "Foo", "Bar.pm") ); require 'Foo'; is( $r, "Foo" ); -require 5.6; -is( $r, "5.6" ); +require 5.006; +is( $r, "5.006" ); require v5.6; ok( abs($r - 5.006) < 0.001 && $r eq "\x05\x06" ); @@ -49,8 +49,8 @@ is( $r, "Foo.pm" ); eval "use Foo::Bar"; is( $r, join($dirsep, "Foo", "Bar.pm") ); -eval "use 5.6"; -is( $r, "5.6" ); +eval "use 5.006"; +is( $r, "5.006" ); # localizing *CORE::GLOBAL::foo should revert to finding CORE::foo { -- 2.7.4