This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Let SvRX(OK) recognise a bare REGEXP.
authorBen Morrow <ben@morrow.me.uk>
Wed, 21 Oct 2009 14:33:55 +0000 (15:33 +0100)
committerRafael Garcia-Suarez <rgs@consttype.org>
Thu, 22 Oct 2009 21:19:23 +0000 (23:19 +0200)
This means that re::is_regexp(${qr/x/}) will now return true.

t/re/re.t
util.c

index 8c1c1f8..87965f2 100644 (file)
--- a/t/re/re.t
+++ b/t/re/re.t
@@ -13,11 +13,21 @@ use re qw(is_regexp regexp_pattern
           regname regnames regnames_count);
 {
     my $qr=qr/foo/pi;
-    ok(is_regexp($qr),'is_regexp($qr)');
+    my $rx = $$qr;
+
+    ok(is_regexp($qr),'is_regexp(REGEXP ref)');
+    ok(is_regexp($rx),'is_regexp(REGEXP)');
     ok(!is_regexp(''),'is_regexp("")');
-    is((regexp_pattern($qr))[0],'foo','regexp_pattern[0]');
-    is((regexp_pattern($qr))[1],'ip','regexp_pattern[1]');
-    is(regexp_pattern($qr),'(?pi-xsm:foo)','scalar regexp_pattern');
+
+    is((regexp_pattern($qr))[0],'foo','regexp_pattern[0] (ref)');
+    is((regexp_pattern($qr))[1],'ip','regexp_pattern[1] (ref)');
+    is(regexp_pattern($qr),'(?pi-xsm:foo)','scalar regexp_pattern (ref)');
+
+    is((regexp_pattern($rx))[0],'foo','regexp_pattern[0] (bare REGEXP)');
+    is((regexp_pattern($rx))[1],'ip','regexp_pattern[1] (bare REGEXP)');
+    is(regexp_pattern($rx),'(?pi-xsm:foo)',
+                                    'scalar regexp_pattern (bare REGEXP)');
+
     ok(!regexp_pattern(''),'!regexp_pattern("")');
 }
 
@@ -42,5 +52,5 @@ if ('1234'=~/(?:(?<A>\d)|(?<C>!))(?<B>\d)(?<A>\d)(?<B>\d)/){
     is(regnames_count(),3);
 }
 # New tests above this line, don't forget to update the test count below!
-BEGIN { plan tests => 14 }
+BEGIN { plan tests => 18 }
 # No tests here!
diff --git a/util.c b/util.c
index b72f263..50675d3 100644 (file)
--- a/util.c
+++ b/util.c
@@ -6054,17 +6054,14 @@ Perl_my_dirfd(pTHX_ DIR * dir) {
 
 REGEXP *
 Perl_get_re_arg(pTHX_ SV *sv) {
-    SV    *tmpsv;
 
     if (sv) {
         if (SvMAGICAL(sv))
             mg_get(sv);
-        if (SvROK(sv) &&
-            (tmpsv = MUTABLE_SV(SvRV(sv))) &&            /* assign deliberate */
-            SvTYPE(tmpsv) == SVt_REGEXP)
-        {
-            return (REGEXP*) tmpsv;
-        }
+        if (SvROK(sv))
+           sv = MUTABLE_SV(SvRV(sv));
+        if (SvTYPE(sv) == SVt_REGEXP)
+            return (REGEXP*) sv;
     }
  
     return NULL;