Make like() and unlike() in t/test.pl refuse non-qr// arguments

[perl5.git] / t / re / pat_advanced.t

diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index 6990940..e39e36c 100644 (file)
--- a/t/re/pat_advanced.t
+++ b/t/re/pat_advanced.t
@@ -17,7 +17,7 @@ $| = 1;
 BEGIN {
     chdir 't' if -d 't';
     @INC = ('../lib','.');
-    require './test.pl';
+    require './test.pl'; require './charset_tools.pl';
     skip_all_if_miniperl("miniperl can't load Tie::Hash::NamedCapture, need for %+ and %-");
 }
 
@@ -1260,6 +1260,7 @@ sub run_tests {
 
     {
         # \, breaks {3,4}
+        no warnings qw{deprecated regexp};
         ok "xaaay"    !~ /xa{3\,4}y/, '\, in a pattern';
         ok "xa{3,4}y" =~ /xa{3\,4}y/, '\, in a pattern';
 
@@ -1872,9 +1873,7 @@ EOP
           'IsPunct disagrees with [:punct:] outside ASCII');
 
         my @isPunctLatin1 = eval q {
-            no warnings 'deprecated';
-            use encoding 'latin1';
-            grep {/[[:punct:]]/ != /\p{IsPunct}/} map {chr} 0x80 .. 0xff;
+            grep {/[[:punct:]]/u != /\p{IsPunct}/} map {chr} 0x80 .. 0xff;
         };
         skip "Eval failed ($@)", 1 if $@;
         skip "PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS set to 0", 1
@@ -2192,7 +2191,7 @@ EOP
     {   # This was failing unless an explicit /d was added
         my $p = qr/[\xE0_]/i;
         utf8::upgrade($p);
-        like("\xC0", $p, "Verify \"\\xC0\" =~ /[\\xE0_]/i; pattern in utf8");
+        like("\xC0", qr/$p/, "Verify \"\\xC0\" =~ /[\\xE0_]/i; pattern in utf8");
     }
 
     ok "x" =~ /\A(?>(?:(?:)A|B|C?x))\z/,
@@ -2299,6 +2298,30 @@ EOP
         return "!B6\n";
     }
 
+    {   # [perl 121777]
+        my $regex;
+        { package Some;
+            # define a Unicode propertyIs_q
+            sub Is_q
+            {
+                sprintf '%x', ord 'q'
+            }
+            $regex = qr/\p{Is_q}/;
+
+            # If we uncomment the following line, prior to the patch that
+            # fixed this, everything would work because we would have expanded
+            # the property by the time the regex in the 'like' below got
+            # compiled.
+            #'q' =~ $regex;
+        }
+
+        like('q', $regex, 'User-defined property matches outside package');
+
+        package Some {
+            main::like('abcq', qr/abc$regex/, 'Run-time compiled in-package user-defined property matches');
+        }
+    }
+
     {   # From Lingua::Stem::UniNE; no ticket filed but related to #121778
         use utf8;
         my $word = 'рабта';
@@ -2409,7 +2432,7 @@ EOP
     { # Regexp:Grammars was broken:
   # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2013-06/msg01290.html
         fresh_perl_like('use warnings; "abc" =~ qr{(?&foo){0}abc(?<foo>)}',
-                        'Quantifier unexpected on zero-length expression',
+                        qr/Quantifier unexpected on zero-length expression/,
                         {},
                         'No segfault on qr{(?&foo){0}abc(?<foo>)}');
     }