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.

4 files changed, 57 insertions, 8 deletions

diff --git a/lib/strict.pm b/lib/strict.pm
index c1544f5c4b..e9fc4ffd69 100644
--- a/lib/strict.pm
+++ b/lib/strict.pm
@@ -19,7 +19,10 @@ sub bits {
     my $bits = 0;
     my @wrong;
     foreach my $s (@_) {
-	push @wrong, $s unless exists $bitmask{$s};
+	if (exists $bitmask{$s}) {
+	    $^H{"strict/$s"} = undef;
+	}
+	else { push @wrong, $s };
         $bits |= $bitmask{$s} || 0;
     }
     if (@wrong) {
@@ -29,16 +32,16 @@ sub bits {
     $bits;
 }
 
-my $default_bits = bits(qw(refs subs vars));
+my @default_bits = qw(refs subs vars);
 
 sub import {
     shift;
-    $^H |= @_ ? bits(@_) : $default_bits;
+    $^H |= bits(@_ ? @_ : @default_bits);
 }
 
 sub unimport {
     shift;
-    $^H &= ~ (@_ ? bits(@_) : $default_bits);
+    $^H &= ~ bits(@_ ? @_ : @default_bits);
 }
 
 1;
diff --git a/op.c b/op.c
index e353015ef5..6bdde587a3 100644
--- a/op.c
+++ b/op.c
@@ -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;
 	}
     }
 
diff --git a/t/comp/use.t b/t/comp/use.t
index c9b76d79a4..ddbed2e63c 100644
--- a/t/comp/use.t
+++ b/t/comp/use.t
@@ -6,7 +6,7 @@ BEGIN {
     $INC{"feature.pm"} = 1; # so we don't attempt to load feature.pm
 }
 
-print "1..73\n";
+print "1..77\n";
 
 # Can't require test.pl, as we're testing the use/require mechanism here.
 
@@ -134,6 +134,17 @@ is ($@, "");
 # and they are properly scoped
 eval '{use 5.11.0;} ${"foo"} = "bar";';
 is ($@, "");
+eval 'no strict; use 5.012; ${"foo"} = "bar"';
+is $@, "", 'explicit "no strict" overrides later ver decl';
+eval 'use strict; use 5.01; ${"foo"} = "bar"';
+like $@, qr/^Can't use string/,
+    'explicit use strict overrides later use 5.01';
+eval 'use strict "subs"; use 5.012; ${"foo"} = "bar"';
+like $@, qr/^Can't use string/,
+    'explicit use strict "subs" does not stop ver decl from enabling refs';
+eval 'use 5.012; use 5.01; ${"foo"} = "bar"';
+is $@, "", 'use 5.01 overrides implicit strict from prev ver decl';
+
 
 { use test_use }	# check that subparse saves pending tokens
 
diff --git a/t/lib/feature/implicit b/t/lib/feature/implicit
index a6c3beac28..3a82f01594 100644
--- a/t/lib/feature/implicit
+++ b/t/lib/feature/implicit
@@ -64,3 +64,17 @@ Helloworld
 # no implicit features with 'no'
 eval "no " . ($]+1); print $@;
 EXPECT
+########
+# lower version after higher version
+sub evalbytes { print "evalbytes sub\n" }
+sub say { print "say sub\n" }
+use 5.015;
+evalbytes "say 'yes'";
+use 5.014;
+evalbytes;
+use 5;
+say "no"
+EXPECT
+yes
+evalbytes sub
+say sub