From a75c6ed6bbe8051aad5c980a7e52906076b66543 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 24 Jan 2012 10:24:21 -0800
Subject: [PATCH] =?utf8?q?[perl=20#108780]=20Make=20=E2=80=98no=20overload?=
 =?utf8?q?ing=E2=80=99=20work=20with=20qr//?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

Traditionally, overload::StrVal(qr//) has returned
Regexp=SCALAR(0xc0ffee), and later Regexp=REGEXP(0xc0c0a) when regexps
were made into first-class SVs.

When the overloading pragma was added in 5.10.1, qr// things were not
accounted for, so they would still stringify as (?-xism:) even with
‘no overloading’ (or as (?^:) under 5.14).

This commit makes the overloading pragma work with qr// things, so
that they stringify the same way as overload::StrVal; i.e., as
Regexp=REGEXP(0xbe600d).
---
 lib/overloading.t | 15 ++++++++++++++-
 sv.c              |  5 ++++-
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/lib/overloading.t b/lib/overloading.t
index 2e1fb40..787edb1 100644
--- a/lib/overloading.t
+++ b/lib/overloading.t
@@ -1,6 +1,6 @@
 #./perl
 
-use Test::More tests => 35;
+use Test::More tests => 46;
 
 use Scalar::Util qw(refaddr);
 
@@ -18,20 +18,25 @@ use Scalar::Util qw(refaddr);
 }
 
 my $x = Stringifies->new;
+my $y = qr//;
+my $ystr = "$y";
 
 is( "$x", "foo", "stringifies" );
+is( "$y", $ystr, "stringifies qr//" );
 is( 0 + $x, 42, "numifies" );
 is( cos($x), "far side of overload table", "cosinusfies" );
 
 {
     no overloading;
     is( "$x", overload::StrVal($x), "no stringification" );
+    is( "$y", overload::StrVal($y), "no stringification of qr//" );
     is( 0 + $x, refaddr($x), "no numification" );
     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
 
     {
 	no overloading '""';
 	is( "$x", overload::StrVal($x), "no stringification" );
+	is( "$y", overload::StrVal($y), "no stringification of qr//" );
 	is( 0 + $x, refaddr($x), "no numification" );
 	is( cos($x), cos(refaddr($x)), "no cosinusfication" );
     }
@@ -41,12 +46,14 @@ is( cos($x), "far side of overload table", "cosinusfies" );
     no overloading '""';
 
     is( "$x", overload::StrVal($x), "no stringification" );
+    is( "$y", overload::StrVal($y), "no stringification of qr//" );
     is( 0 + $x, 42, "numifies" );
     is( cos($x), "far side of overload table", "cosinusfies" );
 
     {
 	no overloading;
 	is( "$x", overload::StrVal($x), "no stringification" );
+	is( "$y", overload::StrVal($y), "no stringification of qr//" );
 	is( 0 + $x, refaddr($x), "no numification" );
 	is( cos($x), cos(refaddr($x)), "no cosinusfication" );
     }
@@ -54,34 +61,40 @@ is( cos($x), "far side of overload table", "cosinusfies" );
     use overloading '""';
 
     is( "$x", "foo", "stringifies" );
+    is( "$y", $ystr, "stringifies qr//" );
     is( 0 + $x, 42, "numifies" );
     is( cos($x), "far side of overload table", "cosinusfies" );
 
     no overloading '0+';
     is( "$x", "foo", "stringifies" );
+    is( "$y", $ystr, "stringifies qr//" );
     is( 0 + $x, refaddr($x), "no numification" );
     is( cos($x), "far side of overload table", "cosinusfies" );
 
     {
 	no overloading '""';
 	is( "$x", overload::StrVal($x), "no stringification" );
+	is( "$y", overload::StrVal($y), "no stringification of qr//" );
 	is( 0 + $x, refaddr($x), "no numification" );
 	is( cos($x), "far side of overload table", "cosinusfies" );
 
 	{
 	    use overloading;
 	    is( "$x", "foo", "stringifies" );
+	    is( "$y", $ystr, "stringifies qr//" );
 	    is( 0 + $x, 42, "numifies" );
 	    is( cos($x), "far side of overload table", "cosinusfies" );
 	}
     }
 
     is( "$x", "foo", "stringifies" );
+    is( "$y", $ystr, "stringifies qr//" );
     is( 0 + $x, refaddr($x), "no numification" );
     is( cos($x), "far side of overload table", "cosinusfies" );
 
     no overloading "cos";
     is( "$x", "foo", "stringifies" );
+    is( "$y", $ystr, "stringifies qr//" );
     is( 0 + $x, refaddr($x), "no numification" );
     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
 
diff --git a/sv.c b/sv.c
index c1ece77..2dce137 100644
--- a/sv.c
+++ b/sv.c
@@ -2809,7 +2809,10 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags
 		if (!referent) {
 		    len = 7;
 		    retval = buffer = savepvn("NULLREF", len);
-		} else if (SvTYPE(referent) == SVt_REGEXP) {
+		} else if (SvTYPE(referent) == SVt_REGEXP && (
+			      !(PL_curcop->cop_hints & HINT_NO_AMAGIC)
+			   || amagic_is_enabled(string_amg)
+			  )) {
 		    REGEXP * const re = (REGEXP *)MUTABLE_PTR(referent);
 		    I32 seen_evals = 0;
 
-- 
1.8.3.1