Fix for non-regexps being upgraded to SVt_REGEXP

$ ./perl -lwe '$a = ${qr//}; $a = 2; print re::is_regexp(\$a)'
1

It is possible for arbitrary SVs (eg PAD entries) to be upgraded to
SVt_REGEXP.  (This is new with first class regexps)

Whilst the example above does not SEGV, it will be possible to write
code that will cause SEGVs (or worse) at the point when the scalar is freed,
because the code in sv_clear() assumes that all scalars of type
SVt_REGEXP *are* regexps, and passes them to pregfree2(), which assumes that
pointers within are valid.

1 files changed, 20 insertions, 3 deletions

diff --git a/t/op/qr.t b/t/op/qr.t
index acabd28af7..13438dea93 100644
--- a/t/op/qr.t
+++ b/t/op/qr.t
@@ -4,7 +4,7 @@ use strict;
 
 require './test.pl';
 
-plan(tests => 12);
+plan(tests => 18);
 
 sub r {
     return qr/Good/;
@@ -37,5 +37,22 @@ isnt($c + 0, $d + 0, 'Not the same object');
 $$d = 'Bad';
 
 like("$c", qr/Good/);
-like("$d", qr/Bad/);
-like("$d1", qr/Bad/);
+is($$d, 'Bad');
+is($$d1, 'Bad');
+
+# Assignment to an implicitly blessed Regexp object retains the class
+# (No different from direct value assignment to any other blessed SV
+
+isa_ok($d, 'Regexp');
+like("$d", qr/\ARegexp=SCALAR\(0x[0-9a-f]+\)\z/);
+
+# As does an explicitly blessed Regexp object.
+
+my $e = bless qr/Faux Pie/, 'Stew';
+
+isa_ok($e, 'Stew');
+$$e = 'Fake!';
+
+is($$e, 'Fake!');
+isa_ok($e, 'Stew');
+like("$e", qr/\Stew=SCALAR\(0x[0-9a-f]+\)\z/);