Replace #21158 with a better patch from Hugo

(for [perl #23769]).

p4raw-id: //depot/perl@21174

diff --git a/regcomp.c b/regcomp.c
index 80e5cfb..07e68bd 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -3310,7 +3310,7 @@ tryagain:
            }
            if (len > 0)
                *flagp |= HASWIDTH;
-           if (len == 1)
+           if (len == 1 && UNI_IS_INVARIANT(ender))
                *flagp |= SIMPLE;
            if (!SIZE_ONLY)
                STR_LEN(ret) = len;

diff --git a/regexec.c b/regexec.c
index d2e9c66..464ceaf 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -4065,16 +4065,10 @@ S_regrepeat(pTHX_ regnode *p, I32 max)
     case CANY:
        scan = loceol;
        break;
-    case EXACT:
-        if (do_utf8) {
-            c = (U8)*STRING(p);
-            while (scan < loceol && utf8_to_uvuni((U8*)scan, 0) == c)
-                 scan += UTF8SKIP(scan);
-       } else {                /* length of string is 1 */
-            c = (U8)*STRING(p);
-            while (scan < loceol && UCHARAT(scan) == c)
-                 scan++;
-       }
+    case EXACT:                /* length of string is 1 */
+       c = (U8)*STRING(p);
+       while (scan < loceol && UCHARAT(scan) == c)
+           scan++;
        break;
     case EXACTF:       /* length of string is 1 */
        c = (U8)*STRING(p);

diff --git a/t/op/pat.t b/t/op/pat.t
index 54f67fc..771e3cd 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..1015\n";
+print "1..1033\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -3221,7 +3221,34 @@ ok("  \x{1E01}x" =~ qr/\x{1E00}X/i,
     ok($s =~ /\x{a0}/,       "[perl #23769]");
     ok($s =~ /\x{a0}+/,      "[perl #23769]");
     ok($s =~ /\x{a0}\x{a0}/, "[perl #23769]");
+
+    ok("aaa\x{100}" =~ /(a+)/, "[perl #23769] easy invariant");
+    ok($1 eq "aaa", "[perl #23769]");
+
+    ok("\xa0\xa0\xa0\x{100}" =~ /(\xa0+)/, "[perl #23769] regrepeat invariant");
+    ok($1 eq "\xa0\xa0\xa0", "[perl #23769]");
+
+    ok("ababab\x{100}  " =~ /((?:ab)+)/, "[perl #23769] hard invariant");
+    ok($1 eq "ababab", "[perl #23769]");
+
+    ok("\xa0\xa1\xa0\xa1\xa0\xa1\x{100}" =~ /((?:\xa0\xa1)+)/, "[perl #23769] hard variant");
+    ok($1 eq "\xa0\xa1\xa0\xa1\xa0\xa1", "[perl #23769]");
+
+    ok("aaa\x{100}     " =~ /(a+?)/, "[perl #23769] easy invariant");
+    ok($1 eq "a", "[perl #23769]");
+
+    ok("\xa0\xa0\xa0\x{100}    " =~ /(\xa0+?)/, "[perl #23769] regrepeat variant");
+    ok($1 eq "\xa0", "[perl #23769]");
+
+    ok("ababab\x{100}  " =~ /((?:ab)+?)/, "[perl #23769] hard invariant");
+    ok($1 eq "ab", "[perl #23769]");
+
+    ok("\xa0\xa1\xa0\xa1\xa0\xa1\x{100}" =~ /((?:\xa0\xa1)+?)/, "[perl #23769] hard variant");
+    ok($1 eq "\xa0\xa1", "[perl #23769]");
+
+    ok("\xc4\xc4\xc4" !~ /(\x{100}+)/, "[perl #23769] don't match first byte of utf8 representation");
+    ok("\xc4\xc4\xc4" !~ /(\x{100}+?)/, "[perl #23769] don't match first byte of utf8 representation");
 }
 
-# last test 1015
+# last test 1033