This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
narrow the filename check in strict.pm/warnings.pm
authorAristotle Pagaltzis <pagaltzis@gmx.de>
Wed, 2 Mar 2016 02:30:30 +0000 (03:30 +0100)
committerAristotle Pagaltzis <pagaltzis@gmx.de>
Wed, 2 Mar 2016 02:30:30 +0000 (03:30 +0100)
• The code previously assumed that any filename basename besides
  `strict.pm` meant that the user mistyped `use strict` (e.g. as
  `use Strict`). But that could just mean the file was not loaded
  from the filesystem, e.g. due to naïve fatpacking.

  This is fixed by adding a guard to check that an unexpected value
  really is a mis-capitalised variant of `strict.pm`.

• The code previously insisted on either slash or backslash as the
  directory separator, which is not strictly portable (though nobody
  noticed in years; apparently nobody has tried to run a recent-ish
  on a MacOS Classic or RiscOS system).

  This is fixed by switching to \b as a best effort, to avoid going
  down the rabbit hole of platform-specific separators.

• The code previously used an `unless` statement, declared lexical
  variables inside its block, and used ${\EXPR} to interpolate the
  __PACKAGE__ constant into the regexp. Each of these increases the
  size of the optree, which is only ever executed once, then sticks
  around wasting some hundred(s) bytes in almost every single Perl
  program in the world.

  This is fixed for warnings.pm by rewriting the code with no use of
  any temporary variables and single-quoted strings instead of regexp
  literals. In strict.pm, we can do even better by moving the code to
  the BEGIN block, since BEGIN CVs are freed after running. (We do not
  add one to warnings.pm since BEGIN blocks have a creation cost.)

lib/strict.pm
lib/warnings.pm
regen/warnings.pl

index 93f2122..f528df7 100644 (file)
@@ -2,16 +2,16 @@ package strict;
 
 $strict::VERSION = "1.10";
 
-# Verify that we're called correctly so that strictures will work.
-unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
-    # Can't use Carp, since Carp uses us!
-    my (undef, $f, $l) = caller;
-    die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
-}
-
 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,
index 8d94724..eab3b63 100644 (file)
@@ -8,11 +8,12 @@ package warnings;
 our $VERSION = "1.35";
 
 # Verify that we're called correctly so that warnings will work.
+# Can't use Carp, since Carp uses us!
+# String regexps because constant folding = smaller optree = less memory vs regexp literal
 # see also strict.pm.
-unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
-    my (undef, $f, $l) = caller;
-    die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
-}
+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' );
 
 our %Offsets = (
     # Warnings Categories added in Perl 5.008
index 18f337e..bed198d 100644 (file)
@@ -489,11 +489,12 @@ package warnings;
 VERSION
 
 # Verify that we're called correctly so that warnings will work.
+# Can't use Carp, since Carp uses us!
+# String regexps because constant folding = smaller optree = less memory vs regexp literal
 # see also strict.pm.
-unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
-    my (undef, $f, $l) = caller;
-    die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
-}
+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' );
 
 KEYWORDS