Skip to content

Zefram/remove version downgrade deprecation #20923

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 4 commits into
base: blead
Choose a base branch
from
Open

Zefram/remove version downgrade deprecation #20923

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
933bd12
hard stricture enablement from "use v5.37" and up
Mar 10, 2023
73d2cfd
abandon future "use VERSION" stricture change
Mar 10, 2023
8c166aa
remove deprecation of downgrading version decls
Mar 10, 2023
5f99d1f
explicit soft stricture control via strict.pm
Mar 10, 2023
File filter

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion embedvar.h
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

6 changes: 0 additions & 6 deletions intrpvar.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1080,12 +1080,6 @@ PERLVAR(I, wcrtomb_ps, mbstate_t)
PERLVARA(I, mem_log, PERL_MEM_LOG_ARYLEN, char)
#endif

/* The most recently seen `use VERSION` declaration, encoded in a single
* U16 as (major << 8) | minor. We do this rather than store an entire SV
* version object so we can fit the U16 into the uv of a SAVEHINTS and not
* have to worry about SV refcounts during scope enter/exit. */
PERLVAR(I, prevailing_version, U16)

/* If you are adding a U8 or U16, check to see if there are 'Space' comments
* above on where there are gaps which currently will be structure padding. */

Expand Down
137 changes: 113 additions & 24 deletions lib/strict.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
package strict;

$strict::VERSION = "1.12";
$strict::VERSION = "1.13";

my ( %bitmask, %explicit_bitmask );

Expand Down Expand Up @@ -37,41 +37,48 @@ BEGIN {
*all_explicit_bits = sub () { $inline_all_explicit_bits };
}

sub bits {
my $bits = 0;
sub _compute_bits {
my $bits = shift;
my $sense = shift;
my $apply_bits = $sense ? sub { $_[0] | $_[1] } : sub { $_[0] & ~$_[1] };
my $adverb = $_[0] // "";
my $proc_bits;
if($adverb eq "softly") {
shift;
$proc_bits = sub { $_[0] & $_[2] ? $_[0] : $apply_bits->($_[0], $_[1]) };
} elsif($adverb eq "forcing_softness") {
shift;
$proc_bits = sub { $apply_bits->($_[0] & ~$_[2], $_[1]) };
} else {
shift if $adverb eq "firmly";
$proc_bits = sub { $apply_bits->($_[0] | $_[2], $_[1]) };
}
my @wrong;
@_ or @_ = qw(refs subs vars);
foreach my $s (@_) {
if (exists $bitmask{$s}) {
$^H |= $explicit_bitmask{$s};

$bits |= $bitmask{$s};
}
else {
if(exists $bitmask{$s}) {
$bits = $proc_bits->($bits, $bitmask{$s}, $explicit_bitmask{$s});
} else {
push @wrong, $s;
}
}
if (@wrong) {
require Carp;
Carp::croak("Unknown 'strict' tag(s) '@wrong'");
}
$bits;
return $bits;
}

sub bits { _compute_bits(0, 1, "softly", @_) }

sub import {
shift;
$^H |= @_ ? &bits : all_bits | all_explicit_bits;
$^H = _compute_bits($^H, 1, @_);
}

sub unimport {
shift;

if (@_) {
$^H &= ~&bits;
}
else {
$^H &= ~all_bits;
$^H |= all_explicit_bits;
}
$^H = _compute_bits($^H, 0, @_);
}

1;
Expand All @@ -97,11 +104,29 @@ strict - Perl pragma to restrict unsafe constructs
The C<strict> pragma disables certain Perl expressions that could behave
unexpectedly or are difficult to debug, turning them into errors. The
effect of this pragma is limited to the current file or scope block.
C<no strict> can be used to reenable the dubious types of expression.

Usually it is best to write programs of more than a couple of lines
with all strictures enabled at the top level, achieved by a simple
C<use strict>. This is the safest mode to operate in. Where a stricture
turns out to be counterproductive, one should then disable the specific
kind of stricture in as small a scope as possible. For example, if one
needs to use a symbolic reference, one can write

$referent = do { no strict "refs"; $$name };

so that symbolic references are permitted for the C<$$name> expression
but remain prohibited in surrounding code.

See L<perlmodlib/Pragmatic Modules>.

=head2 Subjects

If no import list is supplied, all possible restrictions are assumed.
(This is the safest mode to operate in, but is sometimes too strict for
casual programming.) Currently, there are three possible things to be
strict about: "subs", "vars", and "refs".
The main arguments to the pragma are a list specifying which kinds
of expression the stricture is to apply to. Currently, there are
three possible things to be strict about: "subs", "vars", and "refs".
If no such arguments are given then the stricture applies to all three
categories.

=over 6

Expand Down Expand Up @@ -165,7 +190,71 @@ operator applied to it.

=back

See L<perlmodlib/Pragmatic Modules>.
=head2 Adverb

The C<strict> pragma can optionally take an adverb before the (optional)
list of subjects, to say how the declaration should interact with other
declarations that affect strictures. This is not useful when invoking
C<strict> directly to apply to one's own code. It has some value when
setting up a lexical environment for someone else to use via C<eval>,
and also when implementing a lexical pragma that has multiple lexical
effects (a metapragma). The adverb may be:

=over 6

=item B<firmly>

The requested strictures are unconditionally turned on (or off, with
C<no>), and qualify as firmly set. This is the default if no adverb
is given.

=item B<softly>

Any of the requested strictures that were not already firmly set are
turned on (or off, with C<no>), and continue to not qualify as firmly set.
Any that were already firmly set have their status unchanged.

=item B<forcing_softness>

The requested strictures are unconditionally turned on (or off, with
C<no>), and no longer qualify as firmly set.

=back

C<no strict 'forcing_softness'> can be used to cancel the effects of all
prior C<strict> declarations, returning the lexical stricture state to
its default. Specifically, this is needed for subsequent soft stricture
declarations to take effect.

=head2 Stricture implied by version declarations

A L<C<use VERSION>|perlfunc/use VERSION> declaration has some effect
on lexical stricture status. If the specified Perl version is 5.37 or
higher, strictures are firmly enabled, as if by a simple C<use strict>.
If the version is 5.11 or higher but less than 5.37, then strictures are
softly enabled, as if by C<use strict 'softly'>. If the version is less
than 5.11, then strictures are softly disabled, as if by C<no strict
'softly'>.

The version declarations have had these effects on strictures ever since
Perl 5.15.6, which introduced the concept of soft stricture enablement.
On Perls older than that the effects of version declarations was a bit
different: if the version was 5.11 or higher then strictures would be
firmly enabled, and if the version was less than 5.11 then strictures
would be unaffected. This change in meaning of version declarations
for versions less than 5.15 was a historical mistake, which is now too
firmly entrenched to rectify. Beware, therefore, when using a version
declaration with such a low version number. Version declarations for
version 5.16 or higher have no such problem, having always had the same
effect on strictures that they do now.

The main use of the B<softly> adverb to the C<strict> pragma is to
imitate the effect of version declarations for versions less than 5.37.
The concept of soft stricture enablement is now considered a poor
design, and is not recommended for use in metapragmata that don't
specifically need to imitate historical version declarations. It is
also not recommended to build a similar softness facility for a new
pragma that controls anything else.

=head1 HISTORY

Expand Down
154 changes: 140 additions & 14 deletions lib/strict.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
chdir 't' if -d 't';
@INC = ( '.', '../lib' );

our $local_tests = 7;
our $local_tests = 4 + 3*42 + 3*12 + 3*3*38 + 3*11 + 3*18;
require "../t/lib/common.pl";

eval qq(use strict 'garbage');
Expand All @@ -18,17 +18,143 @@ like($@, qr/^Unknown 'strict' tag\(s\) 'foo bar'/);
eval qq(no strict qw(foo bar));
like($@, qr/^Unknown 'strict' tag\(s\) 'foo bar'/);

my $varname = "ccccc";
sub test_strict_all {
my($preamble, $expect) = @_;
my $expect_r = $expect =~ /r/;
eval $preamble.'; ${"ccc"}';
like($@,
$expect_r ?
qr/\ACan't\ use\ string\ \("ccc"\)\ as\ a\ SCALAR\ ref
\ while\ "strict\ refs"\ in\ use/x :
qr/\A\z/,
"\"$preamble\" yields strict refs @{[$expect_r ? q(on) : q(off)]}");
my $expect_v = $expect =~ /v/;
++$varname;
eval $preamble.'; $'.$varname;
like($@,
$expect_v ?
qr/\AGlobal\ symbol\ "\$\Q${varname}\E"\ requires
\ explicit\ package\ name\ /x :
qr/\A\z/,
"\"$preamble\" yields strict vars @{[$expect_v ? q(on) : q(off)]}");
my $expect_s = $expect =~ /s/;
eval $preamble.'; Ccc';
like($@,
$expect_s ?
qr/\ABareword\ "Ccc"\ not\ allowed
\ while\ "strict\ subs"\ in\ use/x :
qr/\A\z/,
"\"$preamble\" yields strict subs @{[$expect_s ? q(on) : q(off)]}");
}

{
test_strict_all "use strict", "rvs";
test_strict_all "no strict", "";
test_strict_all "use strict; no strict", "";
test_strict_all "no strict; use strict", "rvs";
test_strict_all "use strict; no strict 'firmly'", "";
test_strict_all "no strict; use strict 'firmly'", "rvs";
test_strict_all "use strict; no strict 'softly';", "rvs";
test_strict_all "no strict; use strict 'softly';", "";
test_strict_all "use strict; no strict 'forcing_softness';", "";
test_strict_all "no strict; use strict 'forcing_softness';", "rvs";
test_strict_all "use strict 'firmly'", "rvs";
test_strict_all "no strict 'firmly'", "";
test_strict_all "use strict 'firmly'; no strict", "";
test_strict_all "no strict 'firmly'; use strict", "rvs";
test_strict_all "use strict 'firmly'; no strict 'firmly'", "";
test_strict_all "no strict 'firmly'; use strict 'firmly'", "rvs";
test_strict_all "use strict 'firmly'; no strict 'softly';", "rvs";
test_strict_all "no strict 'firmly'; use strict 'softly';", "";
test_strict_all "use strict 'firmly'; no strict 'forcing_softness';", "";
test_strict_all "no strict 'firmly'; use strict 'forcing_softness';", "rvs";
test_strict_all "use strict 'softly'", "rvs";
test_strict_all "no strict 'softly'", "";
test_strict_all "use strict 'softly'; no strict", "";
test_strict_all "no strict 'softly'; use strict", "rvs";
test_strict_all "use strict 'softly'; no strict 'firmly'", "";
test_strict_all "no strict 'softly'; use strict 'firmly'", "rvs";
test_strict_all "use strict 'softly'; no strict 'softly'", "";
test_strict_all "no strict 'softly'; use strict 'softly'", "rvs";
test_strict_all "use strict 'softly'; no strict 'forcing_softness'", "";
test_strict_all "no strict 'softly'; use strict 'forcing_softness'", "rvs";
test_strict_all "use strict 'forcing_softness'", "rvs";
test_strict_all "no strict 'forcing_softness'", "";
test_strict_all "use strict 'forcing_softness'; no strict", "";
test_strict_all "no strict 'forcing_softness'; use strict", "rvs";
test_strict_all "use strict 'forcing_softness'; no strict 'firmly'", "";
test_strict_all "no strict 'forcing_softness'; use strict 'firmly'", "rvs";
test_strict_all "use strict 'forcing_softness'; no strict 'softly'", "";
test_strict_all "no strict 'forcing_softness'; use strict 'softly'", "rvs";
test_strict_all "use strict 'forcing_softness'; no strict 'forcing_softness'", "";
test_strict_all "no strict 'forcing_softness'; use strict 'forcing_softness'", "rvs";
test_strict_all "use strict; no strict 'forcing_softness'; use strict 'softly'", "rvs";
test_strict_all "no strict; use strict 'forcing_softness'; no strict 'softly'", "";
}

{
test_strict_all "use strict 'refs'; no strict 'softly'", "r";
test_strict_all "use strict 'vars'; no strict 'softly'", "v";
test_strict_all "use strict 'subs'; no strict 'softly'", "s";
test_strict_all "no strict 'refs'; use strict 'softly'", "vs";
test_strict_all "no strict 'vars'; use strict 'softly'", "rs";
test_strict_all "no strict 'subs'; use strict 'softly'", "rv";
test_strict_all "use strict softly => 'refs'", "r";
test_strict_all "use strict softly => 'vars'", "v";
test_strict_all "use strict softly => 'subs'", "s";
test_strict_all "no strict; use strict softly => 'refs'", "";
test_strict_all "no strict; use strict softly => 'vars'", "";
test_strict_all "no strict; use strict softly => 'subs'", "";
}

foreach my $minor (0..10) {
test_strict_all "use v5.$minor", "";
test_strict_all "use strict; use v5.$minor", "rvs";
test_strict_all "no strict; use v5.$minor", "";
}
foreach my $minor (11..36) {
test_strict_all "use v5.$minor", "rvs";
test_strict_all "use strict; use v5.$minor", "rvs";
test_strict_all "no strict; use v5.$minor", "";
}
foreach my $minor (37..37) {
test_strict_all "use v5.$minor", "rvs";
test_strict_all "use strict; use v5.$minor", "rvs";
test_strict_all "no strict; use v5.$minor", "rvs";
}

{
my $warnings = "";
local $SIG{__WARN__} = sub { $warnings .= $_[0] };
eval 'use v5.12; use v5.10; ${"c"}';
is($@, '', 'use v5.10 disables implicit strict refs');
like($warnings,
qr/^Downgrading a use VERSION declaration to below v5.11 is deprecated, and will become fatal in Perl 5.40 at /,
'use v5.10 after use v5.12 provokes deprecation warning');
}

eval 'use strict; use v5.10; ${"c"}';
like($@,
qr/^Can't use string \("c"\) as a SCALAR ref while "strict refs" in use/,
"use v5.10 doesn't disable explicit strict ref");
test_strict_all "use v5.8; use v5.10", "";
test_strict_all "use v5.10; use v5.8", "";
test_strict_all "use v5.10; use v5.16", "rvs";
test_strict_all "use v5.10; use v5.37", "rvs";
test_strict_all "use v5.16; use v5.10", "";
test_strict_all "use v5.16; use v5.20", "rvs";
test_strict_all "use v5.20; use v5.16", "rvs";
test_strict_all "use v5.16; use v5.37", "rvs";
test_strict_all "use v5.37; use v5.10", "rvs";
test_strict_all "use v5.37; use v5.16", "rvs";
test_strict_all "use v5.37; use v5.37", "rvs";
}

{
test_strict_all "use strict 'refs'; use v5.10", "r";
test_strict_all "use strict 'vars'; use v5.10", "v";
test_strict_all "use strict 'subs'; use v5.10", "s";
test_strict_all "no strict 'refs'; use v5.10", "";
test_strict_all "no strict 'vars'; use v5.10", "";
test_strict_all "no strict 'subs'; use v5.10", "";
test_strict_all "use strict 'refs'; use v5.16", "rvs";
test_strict_all "use strict 'vars'; use v5.16", "rvs";
test_strict_all "use strict 'subs'; use v5.16", "rvs";
test_strict_all "no strict 'refs'; use v5.16", "vs";
test_strict_all "no strict 'vars'; use v5.16", "rs";
test_strict_all "no strict 'subs'; use v5.16", "rv";
test_strict_all "use strict 'refs'; use v5.37", "rvs";
test_strict_all "use strict 'vars'; use v5.37", "rvs";
test_strict_all "use strict 'subs'; use v5.37", "rvs";
test_strict_all "no strict 'refs'; use v5.37", "rvs";
test_strict_all "no strict 'vars'; use v5.37", "rvs";
test_strict_all "no strict 'subs'; use v5.37", "rvs";
}
Loading