This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Parse-CPAN-Meta to CPAN version 1.4412
[perl5.git] / t / re / pat_advanced.t
index 0c3d2d7..b45c6f1 100644 (file)
@@ -636,14 +636,14 @@ sub run_tests {
           ok "<\x{100}\x{00A0}>" =~ /<\x{100}\s>/, '\x{00A0} in \s';
           ok        "<\x{00A0}>" =~        /<\h>/, '\x{00A0} in \h';
         }
-        my @h = map {sprintf "%05x" => $_} 0x01680, 0x0180E, 0x02000 .. 0x0200A,
+        my @h = map {sprintf "%05x" => $_} 0x01680, 0x02000 .. 0x0200A,
                                            0x0202F, 0x0205F, 0x03000;
         my @v = map {sprintf "%05x" => $_} 0x02028, 0x02029;
 
         my @H = map {sprintf "%05x" => $_} 0x01361,   0x0200B, 0x02408, 0x02420,
-                                           0x0303F,   0xE0020;
+                                           0x0303F,   0xE0020, 0x180E;
         my @V = map {sprintf "%05x" => $_} 0x0008A .. 0x0008D, 0x00348, 0x10100,
-                                           0xE005F,   0xE007C;
+                                           0xE005F,   0xE007C, 0x180E;
 
         for my $hex (@h) {
             my $str = eval qq ["<\\x{$hex}>"];
@@ -1083,6 +1083,16 @@ sub run_tests {
             like ($@, qr/Trailing white-space in a charnames alias definition is deprecated/, "... same under utf8");
         }
 
+        {
+            BEGIN { no strict; *CnameTest:: = *{"_charnames\0A::" } }
+            package CnameTest { sub translator { pop } }
+            BEGIN { $^H{charnames} = \&CnameTest::translator }
+            undef $w;
+            () = eval q ["\N{TOO  MANY SPACES}"];
+            like ($w, qr/A sequence of multiple spaces/,
+                 'translators in _charnames\0* packages get validated');
+        }
+
         # If remove the limitation in regcomp code these should work
         # differently
         undef $w;
@@ -1613,7 +1623,7 @@ sub run_tests {
 
     {
         # Various whitespace special patterns
-        my @h = map {chr $_}   0x09,   0x20,   0xa0, 0x1680, 0x180e, 0x2000,
+        my @h = map {chr $_}   0x09,   0x20,   0xa0, 0x1680, 0x2000,
                              0x2001, 0x2002, 0x2003, 0x2004, 0x2005, 0x2006,
                              0x2007, 0x2008, 0x2009, 0x200a, 0x202f, 0x205f,
                              0x3000;
@@ -2240,12 +2250,13 @@ EOP
     {
         fresh_perl_is('print eval "\"\x{101}\" =~ /[[:lower:]]/", "\n"; print eval "\"\x{100}\" =~ /[[:lower:]]/i", "\n";',
                       "1\n1",   # Both re's should match
-                      "",
+                      {},
                       "get [:lower:] swash in first eval; test under /i in second");
     }
 
     {
         #' RT #119075
+        no warnings 'regexp';   # Silence "has useless greediness modifier"
         local $@;
         eval { /a{0}?/; };
         ok(! $@,
@@ -2253,6 +2264,31 @@ EOP
 
     }
 
+    {
+        unlike("\xB5", qr/^_?\p{IsMyRuntimeProperty}\z/, "yadayada");
+        like("\xB6", qr/^_?\p{IsMyRuntimeProperty}\z/, "yadayada");
+        unlike("\xB7", qr/^_?\p{IsMyRuntimeProperty}\z/, "yadayada");
+        like("\xB5", qr/^_?\P{IsMyRuntimeProperty}\z/, "yadayada");
+        unlike("\xB6", qr/^_?\P{IsMyRuntimeProperty}\z/, "yadayada");
+        like("\xB7", qr/^_?\P{IsMyRuntimeProperty}\z/, "yadayada");
+
+        unlike("_\xB5", qr/^_?\p{IsMyRuntimeProperty}\z/, "yadayada");
+        like("_\xB6", qr/^_?\p{IsMyRuntimeProperty}\z/, "yadayada");
+        unlike("_\xB7", qr/^_?\p{IsMyRuntimeProperty}\z/, "yadayada");
+        like("_\xB5", qr/^_?\P{IsMyRuntimeProperty}\z/, "yadayada");
+        unlike("_\xB6", qr/^_?\P{IsMyRuntimeProperty}\z/, "yadayada");
+        like("_\xB7", qr/^_?\P{IsMyRuntimeProperty}\z/, "yadayada");
+    }
+
+    # These are defined later, so won't be known at regex compile time above
+    sub IsMyRuntimeProperty {
+        return "B6\n";
+    }
+
+    sub IsntMyRuntimeProperty {
+        return "!B6\n";
+    }
+
     #
     # Keep the following tests last -- they may crash perl
     #
@@ -2351,7 +2387,7 @@ EOP
   # 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',
-                        "",
+                        {},
                         'No segfault on qr{(?&foo){0}abc(?<foo>)}');
     }