re_intuit_start(): re-indent a block of code

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

diff --git a/t/re/pat.t b/t/re/pat.t
index 344022e..91274e6 100644 (file)
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -20,7 +20,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 700;  # Update this when adding/deleting tests.
+plan tests => 712;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1217,12 +1217,10 @@ sub run_tests {
         local $SIG{__WARN__} = sub {};
         my $str = "\x{110000}";
 
-        # No non-unicode code points match any Unicode property, even inverse
-        # ones
-        unlike($str, qr/\p{ASCII_Hex_Digit=True}/, "Non-Unicode doesn't match \\p{}");
-        unlike($str, qr/\p{ASCII_Hex_Digit=False}/, "Non-Unicode doesn't match \\p{}");
-        like($str, qr/\P{ASCII_Hex_Digit=True}/, "Non-Unicode matches \\P{}");
-        like($str, qr/\P{ASCII_Hex_Digit=False}/, "Non-Unicode matches \\P{}");
+        unlike($str, qr/\p{ASCII_Hex_Digit=True}/, "Non-Unicode doesn't match \\p{AHEX=True}");
+        like($str, qr/\p{ASCII_Hex_Digit=False}/, "Non-Unicode matches \\p{AHEX=False}");
+        like($str, qr/\P{ASCII_Hex_Digit=True}/, "Non-Unicode matches \\P{AHEX=True}");
+        unlike($str, qr/\P{ASCII_Hex_Digit=False}/, "Non-Unicode matches \\P{AHEX=FALSE}");
     }
 
     {
@@ -1248,7 +1246,7 @@ use utf8;;
 "abc" =~ qr/(?<$char>abc)/;
 EOP
             utf8::encode($prog);
-            fresh_perl_like($prog, qr!Group name must start with a non-digit word character!, "",
+            fresh_perl_like($prog, qr!Group name must start with a non-digit word character!, {},
                         sprintf("'U+%04X not legal IDFirst'", ord($char)));
         }
     }
@@ -1482,9 +1480,66 @@ EOP
     {
        is runperl(prog => 'delete $::{qq-\cR-}; //; print qq-ok\n-'),
           "ok\n",
-          'deleting *^R does not result in crashes'
+          'deleting *^R does not result in crashes';
+       no warnings 'once';
+       *^R = *caretRglobwithnoscalar;
+       "" =~ /(?{42})/;
+       is $^R, 42, 'assigning to *^R does not result in a crash';
+       is runperl(
+            stderr => 1,
+            prog => 'eval q|'
+                   .' q-..- =~ /(??{undef *^R;q--})(?{42})/; '
+                    .' print qq-$^R\n-'
+                   .'|'
+          ),
+          "42\n",
+          'undefining *^R within (??{}) does not result in a crash';
+    }
+
+    {
+        # [perl #120446]
+        # this code should be virtually instantaneous. If it takes 10s of
+        # seconds, there a bug in intuit_start.
+        # (this test doesn't actually test for slowness - that involves
+        # too much danger of false positives on loaded machines - but by
+        # putting it here, hopefully someone might notice if it suddenly
+        # runs slowly)
+        my $s = ('a' x 1_000_000) . 'b';
+        my $i = 0;
+        for (1..10_000) {
+            pos($s) = $_;
+            $i++ if $s =~/\Gb/g;
+        }
+        is($i, 0, "RT 120446: mustn't run slowly");
+    }
+
+    # These are based on looking at the code in regcomp.c
+    # We don't look for specific code, just the existence of an SSC
+    foreach my $re (qw(     qr/a?c/
+                            qr/a?c/i
+                            qr/[ab]?c/
+                            qr/\R?c/
+                            qr/\d?c/d
+                            qr/\w?c/l
+                            qr/\s?c/a
+                            qr/[[:alpha:]]?c/u
+    )) {
+      SKIP: {
+        skip "no re-debug under miniperl" if is_miniperl;
+        my $prog = <<"EOP";
+use re qw(Debug COMPILE);
+$re;
+EOP
+        fresh_perl_like($prog, qr/synthetic stclass/, { stderr=>1 }, "$re generates a synthetic start class");
+      }
+    }
+
+    {
+        like "\x{AA}", qr/a?[\W_]/d, "\\W with /d synthetic start class works";
     }
 
+
+
 } # End of sub run_tests
 
 1;