This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Bump File::Copy to version 2.29.
[perl5.git] / lib / locale.t
index e4d0e17..f78d0c8 100644 (file)
@@ -282,6 +282,13 @@ check_taint_not  $2;
 
 check_taint_not  $a;
 
+"a" =~ /([a-z])/;
+check_taint_not $1, '"a" =~ /([a-z])/';
+"foo.bar_baz" =~ /^(.*)[._](.*?)$/;  # Bug 120675
+check_taint_not $1, '"foo.bar_baz" =~ /^(.*)[._](.*?)$/';
+
+# BE SURE TO COPY ANYTHING YOU ADD to the block below
+
 {   # This is just the previous tests copied here with a different
     # compile-time pragma.
 
@@ -444,6 +451,11 @@ check_taint_not  $a;
     # After all this tainting $a should be cool.
 
     check_taint_not  $a;
+
+    "a" =~ /([a-z])/;
+    check_taint_not $1, '"a" =~ /([a-z])/';
+    "foo.bar_baz" =~ /^(.*)[._](.*?)$/;  # Bug 120675
+    check_taint_not $1, '"foo.bar_baz" =~ /^(.*)[._](.*?)$/';
 }
 
 # Here are in scope of 'use locale'
@@ -1899,9 +1911,7 @@ foreach $Locale (@Locale) {
                     print "# Regex characters in '$x' or '$y', skipping test $locales_test_number for locale '$Locale'\n";
                     next;
                 }
-                # With utf8 both will fail since the locale concept
-                # of upper/lower does not work well in Unicode.
-                push @f, $x unless $x =~ /$y/i == $y =~ /$x/i;
+                push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
 
                 # fc is not a locale concept, so Perl uses lc for it.
                 push @f, $x unless lc $x eq fc $x;
@@ -1920,8 +1930,6 @@ foreach $Locale (@Locale) {
                             $y =~ /$x/i ? 1 : 0,
                             "\n");
 
-                # Here, we can fully test things, unlike plain 'use locale',
-                # because this form does work well with Unicode
                 push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
 
                 # The places where Unicode's lc is different from fc are
@@ -1947,9 +1955,7 @@ foreach $Locale (@Locale) {
                     print "# Regex characters in '$x' or '$y', skipping test $locales_test_number for locale '$Locale'\n";
                     next;
                 }
-                # With utf8 both will fail since the locale concept
-                # of upper/lower does not work well in Unicode.
-                push @f, $x unless $x =~ /$y/i == $y =~ /$x/i;
+                push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
 
                 push @f, $x unless lc $x eq fc $x;
             }
@@ -2256,11 +2262,19 @@ if ($didwarn) {
         my $F = join(" ", @F);
         $F =~ s/(.{50,60}) /$1\n#\t/g;
 
+        my $details = "";
+        unless ($debug) {
+            $details = "# For more details, rerun, with environment variable PERL_DEBUG_FULL_TEST=1.\n";
+        }
+        elsif ($debug == 1) {
+            $details = "# For even more details, rerun, with environment variable PERL_DEBUG_FULL_TEST=2.\n";
+        }
+
         warn
           "# The following locales\n#\n",
           "#\t", $F, "\n#\n",
           "# had problems.\n#\n",
-          "# For more details, rerun, with environment variable PERL_DEBUG_FULL_TEST=1.\n";
+          $details;
     } else {
         warn "# None of your locales were broken.\n";
     }