[perl #126593] make sure utf8_heavy.pl doesn't depend on itself

With ${^ENCODING} set, it did.

Partly reverts:

commit aa8f6cef961dc2009604f7464c66106421c3ae81
Author: Rafael Garcia-Suarez <rgs@consttype.org>
Date:   Wed Jun 17 13:18:59 2015 +0200

    Microoptimize some matches in utf8_heavy.pl

diff --git a/MANIFEST b/MANIFEST
index ca2c455..b10f84f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5550,6 +5550,7 @@ t/uni/fold.t                      See if Unicode folding works
 t/uni/goto.t                   See if Unicode goto &sub works
 t/uni/greek.t                  See if Unicode in greek works
 t/uni/gv.t                     See if Unicode GVs work.
+t/uni/heavy.t                  See if utf8_heavy.pl uses perl that depends on it
 t/uni/labels.t                 See if Unicode labels work
 t/uni/latin2.t                 See if Unicode in latin2 works
 t/uni/lex_utf8.t               See if Unicode in lexer works

diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
index 0d2e662..872704a 100644 (file)
--- a/lib/utf8_heavy.pl
+++ b/lib/utf8_heavy.pl
@@ -20,7 +20,7 @@ sub _loose_name ($) {
     # out blanks, underscores and dashes.  The complication stems from the
     # grandfathered-in 'L_', which retains a single trailing underscore.
 
-    (my $loose = $_[0]) =~ tr/-_ \t//d;
+    (my $loose = $_[0]) =~ s/[-_ \t]//g;
 
     return $loose if $loose !~ / ^ (?: is | to )? l $/x;
     return 'l_' if $_[0] =~ / l .* _ /x;    # If original had a trailing '_'

diff --git a/t/uni/heavy.t b/t/uni/heavy.t
new file mode 100644 (file)
index 0000000..c257dbc
--- /dev/null
+++ b/t/uni/heavy.t
@@ -0,0 +1,40 @@
+#!./perl -w
+# tests that utf8_heavy.pl doesn't use anything that prevents it loading
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan tests => 1;
+
+# see [perl #126593]
+fresh_perl_is(<<'EOP', "", { stderr => 1 }, "doesn't break with \${^ENCODING}");
+no warnings qw(deprecated);
+package Foo;
+sub cat_decode {
+    # stolen from Encode.pm
+    my ( undef, undef, undef, $pos, $trm ) = @_;
+    my ( $rdst, $rsrc, $rpos ) = \@_[ 1, 2, 3 ];
+    use bytes;
+    if ( ( my $npos = index( $$rsrc, $trm, $pos ) ) >= 0 ) {
+        $$rdst .=
+          substr( $$rsrc, $pos, $npos - $pos + length($trm) );
+        $$rpos = $npos + length($trm);
+        return 1;
+    }
+    $$rdst .= substr( $$rsrc, $pos );
+    $$rpos = length($$rsrc);
+    return q();
+}
+
+sub decode {
+   my (undef, $tmp) = @_;
+   utf8::decode($tmp);
+   $tmp;
+}
+
+BEGIN { ${^ENCODING} = bless [], q(Foo) };
+
+(my $tmp = q(abc)) =~ tr/abc/123/;
+EOP