diff options
author | Karl Berry <karl@freefriends.org> | 2016-04-05 22:27:26 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2016-04-05 22:27:26 +0000 |
commit | b56b320b5e2515160073fa1b469514002688fe11 (patch) | |
tree | 965a7100c5e45fca8ec803d22b8b6ce14fca4633 /Master/tlpkg/tlperl/lib/strict.pm | |
parent | d26c206452d2e285c3bbf949f34011e4a55fd8f9 (diff) |
tlperl 5.22.1 from siep
git-svn-id: svn://tug.org/texlive/trunk@40252 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/strict.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/strict.pm | 65 |
1 files changed, 45 insertions, 20 deletions
diff --git a/Master/tlpkg/tlperl/lib/strict.pm b/Master/tlpkg/tlperl/lib/strict.pm index 8eed8bc3f7b..03ed21ca81f 100644 --- a/Master/tlpkg/tlperl/lib/strict.pm +++ b/Master/tlpkg/tlperl/lib/strict.pm @@ -1,6 +1,6 @@ package strict; -$strict::VERSION = "1.08"; +$strict::VERSION = "1.09"; # Verify that we're called correctly so that strictures will work. unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) { @@ -9,26 +9,46 @@ unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) { die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n"); } -my %bitmask = ( -refs => 0x00000002, -subs => 0x00000200, -vars => 0x00000400 -); -my %explicit_bitmask = ( -refs => 0x00000020, -subs => 0x00000040, -vars => 0x00000080 -); +my ( %bitmask, %explicit_bitmask ); + +BEGIN { + %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}; - } - else { push @wrong, $s }; - $bits |= $bitmask{$s} || 0; + if (exists $bitmask{$s}) { + $^H |= $explicit_bitmask{$s}; + + $bits |= $bitmask{$s}; + } + else { + push @wrong, $s; + } } if (@wrong) { require Carp; @@ -37,16 +57,21 @@ sub bits { $bits; } -my @default_bits = qw(refs subs vars); - sub import { shift; - $^H |= bits(@_ ? @_ : @default_bits); + $^H |= @_ ? &bits : all_bits | all_explicit_bits; } sub unimport { shift; - $^H &= ~ bits(@_ ? @_ : @default_bits); + + if (@_) { + $^H &= ~&bits; + } + else { + $^H &= ~all_bits; + $^H |= all_explicit_bits; + } } 1; |