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>
Mon, 30 Jan 2012 20:33:31 +0000 (12:33 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 30 Jan 2012 20:34:06 +0000 (12:34 -0800)
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.

lib/overloading.t
pp_ctl.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 a99a78e..a679f41 100644 (file)
--- 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);