summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/strict.pm
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2016-04-05 22:27:26 +0000
committerKarl Berry <karl@freefriends.org>2016-04-05 22:27:26 +0000
commitb56b320b5e2515160073fa1b469514002688fe11 (patch)
tree965a7100c5e45fca8ec803d22b8b6ce14fca4633 /Master/tlpkg/tlperl/lib/strict.pm
parentd26c206452d2e285c3bbf949f34011e4a55fd8f9 (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.pm65
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;