diff options
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; |