Optimise strict.pm for the common case

Author: JRaspass

lib/strict.pm

@@ -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;

lib/strict.t

@@ -3,7 +3,7 @@
 chdir 't' if -d 't';
 @INC = '../lib';
 
-our $local_tests = 4;
+our $local_tests = 6;
 require "../t/lib/common.pl";
 
 eval qq(use strict 'garbage');
@@ -17,3 +17,11 @@ like($@, qr/^Unknown 'strict' tag\(s\) 'foo bar'/);
 
 eval qq(no strict qw(foo bar));
 like($@, qr/^Unknown 'strict' tag\(s\) 'foo bar'/);
+
+eval 'use v5.12; use v5.10; ${"c"}';
+is($@, '', 'use v5.10 disables implicit strict refs');
+
+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");