[perl #108780] Make /foo$qr/ work under ‘no overloading’

This changes the code in pp_regcomp to use the underlying REGEXP
instead of the reference to it, when concatenating pieces to mark a
larger regular expression.  This makes /foo$qr/ work even under ‘no
overloading’.  It stopped working with commit a75c6ed6b.

2 files changed, 18 insertions, 1 deletions

diff --git a/lib/overloading.t b/lib/overloading.t
index 787edb1b9d..85fc7e2c94 100644
--- a/lib/overloading.t
+++ b/lib/overloading.t
@@ -1,6 +1,6 @@
 #./perl
 
-use Test::More tests => 46;
+use Test::More tests => 50;
 
 use Scalar::Util qw(refaddr);
 
@@ -50,6 +50,16 @@ is( cos($x), "far side of overload table", "cosinusfies" );
     is( 0 + $x, 42, "numifies" );
     is( cos($x), "far side of overload table", "cosinusfies" );
 
+    my $q = qr/abc/;
+    ok "abc" =~ $q, '=~ qr// with no "" overloading';
+    ok "abcd" =~ /${q}d/, '=~ /foo$qr/ with no "" overloading';
+    {
+	no overloading 'qr';
+	my $q = qr/abc/;
+	ok "abc" =~ $q, '=~ qr// with no "" or qr overloading';
+	ok "abcd" =~ /${q}d/, '=~ /foo$qr/ with no "" or qr overloading';
+    }
+
     {
 	no overloading;
 	is( "$x", overload::StrVal($x), "no stringification" );
diff --git a/pp_ctl.c b/pp_ctl.c
index a99a78ec84..a679f41864 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -130,6 +130,13 @@ PP(pp_regcomp)
 	       sv_setsv(tmpstr, sv);
 	       continue;
 	    }
+
+	    if (SvROK(msv) && SvTYPE(SvRV(msv)) == SVt_REGEXP) {
+		msv = SvRV(msv);
+		PL_reginterp_cnt +=
+		    RX_SEEN_EVALS((REGEXP *)MUTABLE_PTR(msv));
+	    }
+
 	    sv_catsv_nomg(tmpstr, msv);
 	}
     	SvSETMAGIC(tmpstr);