diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/texlive/tlnet/tlpkg/tlperl/lib/strict.pm |
Initial commit
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/strict.pm')
-rw-r--r-- | systems/texlive/tlnet/tlpkg/tlperl/lib/strict.pm | 184 |
1 files changed, 184 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/strict.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/strict.pm new file mode 100644 index 0000000000..923c921363 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/strict.pm @@ -0,0 +1,184 @@ +package strict; + +$strict::VERSION = "1.11"; + +my ( %bitmask, %explicit_bitmask ); + +BEGIN { + # Verify that we're called correctly so that strictures will work. + # Can't use Carp, since Carp uses us! + # see also warnings.pm. + die sprintf "Incorrect use of pragma '%s' at %s line %d.\n", __PACKAGE__, +(caller)[1,2] + if __FILE__ !~ ( '(?x) \b '.__PACKAGE__.' \.pmc? \z' ) + && __FILE__ =~ ( '(?x) \b (?i:'.__PACKAGE__.') \.pmc? \z' ); + + %bitmask = ( + refs => 0x00000002, + subs => 0x00000200, + vars => 0x00000400, + ); + + %explicit_bitmask = ( + refs => 0x00000020, + subs => 0x00000040, + vars => 0x00000080, + ); + + my $bits = 0; + $bits |= $_ for values %bitmask; + + my $inline_all_bits = $bits; + *all_bits = sub () { $inline_all_bits }; + + $bits = 0; + $bits |= $_ for values %explicit_bitmask; + + my $inline_all_explicit_bits = $bits; + *all_explicit_bits = sub () { $inline_all_explicit_bits }; +} + +sub bits { + my $bits = 0; + my @wrong; + foreach my $s (@_) { + if (exists $bitmask{$s}) { + $^H |= $explicit_bitmask{$s}; + + $bits |= $bitmask{$s}; + } + else { + push @wrong, $s; + } + } + if (@wrong) { + require Carp; + Carp::croak("Unknown 'strict' tag(s) '@wrong'"); + } + $bits; +} + +sub import { + shift; + $^H |= @_ ? &bits : all_bits | all_explicit_bits; +} + +sub unimport { + shift; + + if (@_) { + $^H &= ~&bits; + } + else { + $^H &= ~all_bits; + $^H |= all_explicit_bits; + } +} + +1; +__END__ + +=head1 NAME + +strict - Perl pragma to restrict unsafe constructs + +=head1 SYNOPSIS + + use strict; + + use strict "vars"; + use strict "refs"; + use strict "subs"; + + use strict; + no strict "vars"; + +=head1 DESCRIPTION + +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. + +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". + +=over 6 + +=item C<strict refs> + +This generates a runtime error if you +use symbolic references (see L<perlref>). + + use strict 'refs'; + $ref = \$foo; + print $$ref; # ok + $ref = "foo"; + print $$ref; # runtime error; normally ok + $file = "STDOUT"; + print $file "Hi!"; # error; note: no comma after $file + +There is one exception to this rule: + + $bar = \&{'foo'}; + &$bar; + +is allowed so that C<goto &$AUTOLOAD> would not break under stricture. + + +=item C<strict vars> + +This generates a compile-time error if you access a variable that was +neither explicitly declared (using any of C<my>, C<our>, C<state>, or C<use +vars>) nor fully qualified. (Because this is to avoid variable suicide +problems and subtle dynamic scoping issues, a merely C<local> variable isn't +good enough.) See L<perlfunc/my>, L<perlfunc/our>, L<perlfunc/state>, +L<perlfunc/local>, and L<vars>. + + use strict 'vars'; + $X::foo = 1; # ok, fully qualified + my $foo = 10; # ok, my() var + local $baz = 9; # blows up, $baz not declared before + + package Cinna; + our $bar; # Declares $bar in current package + $bar = 'HgS'; # ok, global declared via pragma + +The local() generated a compile-time error because you just touched a global +name without fully qualifying it. + +Because of their special use by sort(), the variables $a and $b are +exempted from this check. + +=item C<strict subs> + +This disables the poetry optimization, generating a compile-time error if +you try to use a bareword identifier that's not a subroutine, unless it +is a simple identifier (no colons) and that it appears in curly braces or +on the left hand side of the C<< => >> symbol. + + use strict 'subs'; + $SIG{PIPE} = Plumber; # blows up + $SIG{PIPE} = "Plumber"; # fine: quoted string is always ok + $SIG{PIPE} = \&Plumber; # preferred form + +=back + +See L<perlmodlib/Pragmatic Modules>. + +=head1 HISTORY + +C<strict 'subs'>, with Perl 5.6.1, erroneously permitted to use an unquoted +compound identifier (e.g. C<Foo::Bar>) as a hash key (before C<< => >> or +inside curlies), but without forcing it always to a literal string. + +Starting with Perl 5.8.1 strict is strict about its restrictions: +if unknown restrictions are used, the strict pragma will abort with + + Unknown 'strict' tag(s) '...' + +As of version 1.04 (Perl 5.10), strict verifies that it is used as +"strict" to avoid the dreaded Strict trap on case insensitive file +systems. + +=cut |