This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #108780] Make /foo$qr/ work under ‘no overloading’
authorFather Chrysostomos <sprout@cpan.org>
Tue, 14 Feb 2012 19:50:10 +0000 (19:50 +0000)
committerDavid Mitchell <davem@iabyn.com>
Wed, 13 Jun 2012 12:32:48 +0000 (13:32 +0100)
This commit redoes 37c07a4b2, which had to be reverted to allow the
re-eval work to be rebased onto blead.

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

lib/overloading.t
regcomp.c

index 787edb1..85fc7e2 100644 (file)
@@ -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" );
index 75ed11b..87f33e7 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5250,6 +5250,11 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
 
                }
                else {
+                   if (SvROK(msv) && SvTYPE(SvRV(msv)) == SVt_REGEXP) {
+                       msv = SvRV(msv);
+                       PL_reginterp_cnt +=
+                           RX_SEEN_EVALS((REGEXP *)MUTABLE_PTR(msv));
+                   }
                    sv_catsv_nomg(pat, msv);
                    if (code)
                        pRExC_state->code_blocks[n-1].end = SvCUR(pat)-1;