[perl #118297] Fix interpolating downgraded variables into upgraded regexp

The code alredy upgraded the pattern if interpolating an upgraded
string into it, but not vice versa.  Just use sv_catsv_nomg() instead
of sv_catpvn_nomg(), so that it can upgrade as necessary.

diff --git a/regcomp.c b/regcomp.c
index 0c0f073..6bd7efd 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5117,16 +5117,15 @@ S_concat_pat(pTHX_ RExC_state_t * const pRExC_state,
                  *     sv_catsv_nomg(pat, msv);
                  * that allows us to adjust code block indices if
                  * needed */
-                STRLEN slen, dlen;
+                STRLEN dlen;
                 char *dst = SvPV_force_nomg(pat, dlen);
-                const char *src = SvPV_flags_const(msv, slen, 0);
                 orig_patlen = dlen;
                 if (SvUTF8(msv) && !SvUTF8(pat)) {
                     S_pat_upgrade_to_utf8(aTHX_ pRExC_state, &dst, &dlen, n);
                     sv_setpvn(pat, dst, dlen);
                     SvUTF8_on(pat);
                 }
-                sv_catpvn_nomg(pat, src, slen);
+                sv_catsv_nomg(pat, msv);
                 rx = msv;
             }
             else

diff --git a/t/re/pat.t b/t/re/pat.t
index 05bb650..bdfea87 100644 (file)
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -20,7 +20,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 467;  # Update this when adding/deleting tests.
+plan tests => 470;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1349,6 +1349,19 @@ EOP
         like("ab", qr/a( ?#foo)b/x);
     }
 
+    { # 118297: Mixing up- and down-graded strings in regex
+        utf8::upgrade(my $u = "\x{e5}");
+        utf8::downgrade(my $d = "\x{e5}");
+        my $warned;
+        local $SIG{__WARN__} = sub { $warned++ if $_[0] =~ /\AMalformed UTF-8/ };
+        my $re = qr/$u$d/;
+        ok(!$warned, "no warnings when interpolating mixed up-/downgraded strings in pattern");
+        my $c = "\x{e5}\x{e5}";
+        utf8::downgrade($c);
+        like($c, $re, "mixed up-/downgraded pattern matches downgraded string");
+        utf8::upgrade($c);
+        like($c, $re, "mixed up-/downgraded pattern matches upgraded string");
+    }
 
 } # End of sub run_tests