Skip to content

Commit

Permalink
Implement new ‘use 5.xxx' plan
Browse files Browse the repository at this point in the history
• 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.
  • Loading branch information
Father Chrysostomos committed Dec 7, 2011
1 parent 0c9fdf2 commit b50b205
Show file tree
Hide file tree
Showing 4 changed files with 57 additions and 8 deletions.
11 changes: 7 additions & 4 deletions lib/strict.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand All @@ -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;
Expand Down
27 changes: 24 additions & 3 deletions op.c
Original file line number Diff line number Diff line change
Expand Up @@ -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));
Expand All @@ -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;
}
}

Expand Down
13 changes: 12 additions & 1 deletion t/comp/use.t
Original file line number Diff line number Diff line change
Expand Up @@ -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.

Expand Down Expand Up @@ -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

Expand Down
14 changes: 14 additions & 0 deletions t/lib/feature/implicit
Original file line number Diff line number Diff line change
Expand Up @@ -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

0 comments on commit b50b205

Please sign in to comment.