This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #128260] Fix \substr %h
[perl5.git] / t / op / utftaint.t
index 1294526..da4f842 100644 (file)
@@ -3,7 +3,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(../lib);
+    require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
@@ -17,16 +18,12 @@ sub tainted ($) {
     any_tainted @_;
 }
 
-require './test.pl';
-plan(tests => 3*10 + 3*8 + 2*16 + 2);
+plan(tests => 3*10 + 3*8 + 2*16 + 3);
 
 my $arg = $ENV{PATH}; # a tainted value
 use constant UTF8 => "\x{1234}";
 
-sub is_utf8 {
-    my $s = shift;
-    return 0xB6 != unpack('C', chr(0xB6).$s);
-}
+*is_utf8 = \&utf8::is_utf8;
 
 for my $ary ([ascii => 'perl'], [latin1 => "\xB6"], [utf8 => "\x{100}"]) {
     my $encode = $ary->[0];
@@ -143,10 +140,25 @@ for my $ary ([ascii => 'perl'], [latin1 => "\xB6"]) {
     is(tainted($taint), tainted($arg), "tainted: $encode, downgrade down");
 }
 
-fresh_perl_is('$a = substr $^X, 0, 0; /\x{100}/i; /$a\x{100}/i || print q,ok,',
-             'ok', {switches => ["-T", "-l"]},
-             "matching a regexp is taint agnostic");
+SKIP: {
+    if (is_miniperl()) {
+        skip_if_miniperl("Unicode tables not built yet", 2)
+            unless eval 'require "unicore/Heavy.pl"';
+    }
+    fresh_perl_is('$a = substr $^X, 0, 0; /\x{100}/i; /$a\x{100}/i || print q,ok,',
+                 'ok', {switches => ["-T", "-l"]},
+                 "matching a regexp is taint agnostic");
+
+    fresh_perl_is('$a = substr $^X, 0, 0; /$a\x{100}/i || print q,ok,',
+                 'ok', {switches => ["-T", "-l"]},
+                 "therefore swash_init should be taint agnostic");
+}
+
+{
+    # RT #122148: s///e on tainted utf8 strings got pos() messed up in 5.20
 
-fresh_perl_is('$a = substr $^X, 0, 0; /$a\x{100}/i || print q,ok,',
-             'ok', {switches => ["-T", "-l"]},
-             "therefore swash_init should be taint agnostic");
+    my @p;
+    my $s = "\x{100}\x{100}\x{100}\x{100}". $^X;
+    $s =~ s/\x{100}/push @p, pos($s); "xxxx";/eg;
+    is("@p", "0 1 2 3", "RT #122148");
+}