SvRX() and SvRXOK() macros

From: "Ævar Arnfjörð Bjarmason" <avarab@gmail.com>
Message-ID: <51dd1af80706172033h1908aa0ge15698204e0b79ed@mail.gmail.com>

p4raw-id: //depot/perl@31409

diff --git a/embed.fnc b/embed.fnc
index ef1d961..3939155 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1871,7 +1871,7 @@ AMdnoP    |int    |Perl_signbit   |NV f
 #endif
 
 XEMop  |void   |emulate_cop_io |NN const COP *const c|NN SV *const sv
-XEMop  |regexp *|get_re_arg|NULLOK SV *sv|U32 flags|NULLOK MAGIC **mgp
+XEMop  |REGEXP *|get_re_arg|NULLOK SV *sv
 
 p      |struct mro_meta*       |mro_meta_init  |NN HV* stash
 #if defined(USE_ITHREADS)

diff --git a/ext/re/re.xs b/ext/re/re.xs
index 2e93400..b4d3e34 100644 (file)
--- a/ext/re/re.xs
+++ b/ext/re/re.xs
@@ -61,25 +61,6 @@ const struct regexp_engine my_reg_engine = {
 #endif
 };
 
-REGEXP *
-get_re_arg( pTHX_ SV *sv, U32 flags, MAGIC **mgp) {
-    MAGIC *mg;
-    if (sv) {
-        if (SvMAGICAL(sv))
-            mg_get(sv);
-        if (SvROK(sv) &&
-            (sv = (SV*)SvRV(sv)) &&     /* assign deliberate */
-            SvTYPE(sv) == SVt_PVMG &&
-            (mg = mg_find(sv, PERL_MAGIC_qr))) /* assign deliberate */
-        {        
-            if (mgp) *mgp = mg;
-            return (REGEXP *)mg->mg_obj;       
-        }
-    }    
-    if (mgp) *mgp = NULL;
-    return ((flags && PL_curpm) ? PM_GETRE(PL_curpm) : NULL);
-}
-
 MODULE = re    PACKAGE = re
 
 void
@@ -95,7 +76,6 @@ regexp_pattern(sv)
     SV * sv
 PROTOTYPE: $
 PREINIT:
-    MAGIC *mg;
     REGEXP *re;
 PPCODE:
 {
@@ -110,7 +90,7 @@ PPCODE:
        on the object. 
     */
 
-    if ( re = get_re_arg( aTHX_ sv, 0, &mg) ) /* assign deliberate */
+    if ((re = SvRX(sv))) /* assign deliberate */
     {
         /* Housten, we have a regex! */
         SV *pattern;
@@ -184,7 +164,7 @@ PREINIT:
     REGEXP *re;
 PPCODE:
 {
-    if ( re = get_re_arg( aTHX_ sv, 0, 0) ) /* assign deliberate */
+    if ((re = SvRX(sv))) /* assign deliberate */
     {
         SV *an = &PL_sv_no;
         SV *fl = &PL_sv_no;

diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index cd84734..e4ae012 100644 (file)
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -3135,6 +3135,50 @@ Found in file intrpvar.h
 
 =back
 
+=head1 REGEXP Functions
+
+=over 8
+
+=item SvRX
+X<SvRX>
+
+Convenience macro to get the REGEXP from a SV. This is approximately
+equivalent to the following snippet:
+
+    if (SvMAGICAL(sv))
+        mg_get(sv);
+    if (SvROK(sv) &&
+        (tmpsv = (SV*)SvRV(sv)) &&
+        SvTYPE(tmpsv) == SVt_PVMG &&
+        (tmpmg = mg_find(tmpsv, PERL_MAGIC_qr)))
+    {
+        return (REGEXP *)tmpmg->mg_obj;
+    }
+
+NULL will be returned if a REGEXP* is not found.
+
+       REGEXP *        SvRX(SV *sv)
+
+=for hackers
+Found in file regexp.h
+
+=item SvRXOK
+X<SvRXOK>
+
+Returns a boolean indicating whether the SV contains qr magic
+(PERL_MAGIC_qr).
+
+If you want to do something with the REGEXP* later use SvRX instead
+and check for NULL.
+
+       bool    SvRXOK(SV* sv)
+
+=for hackers
+Found in file regexp.h
+
+
+=back
+
 =head1 Simple Exception Handling Macros
 
 =over 8

diff --git a/pod/perlreapi.pod b/pod/perlreapi.pod
index 2ac4c16..c218c10 100644 (file)
--- a/pod/perlreapi.pod
+++ b/pod/perlreapi.pod
@@ -378,23 +378,13 @@ package as a normal object.
     my $re = qr//;
     $re->meth; # dispatched to re::engine::Example::meth()
 
-To retrieve the C<REGEXP> object from the scalar in an XS function use the
-following snippet:
+To retrieve the C<REGEXP> object from the scalar in an XS function use
+the C<SvRX> macro, see L<"REGEXP Functions" in perlapi|perlapi/REGEXP
+Functions>.
 
     void meth(SV * rv)
     PPCODE:
-        MAGIC  * mg;
-        REGEXP * re;
-
-        if (SvMAGICAL(sv))
-            mg_get(sv);
-        if (SvROK(sv) &&
-            (sv = (SV*)SvRV(sv)) &&            /* assignment deliberate */
-            SvTYPE(sv) == SVt_PVMG &&
-            (mg = mg_find(sv, PERL_MAGIC_qr))) /* assignment deliberate */
-        {
-            re = (REGEXP *)mg->mg_obj;
-        }
+        REGEXP * re = SvRX(sv);
 
 =head2 dupe
 

diff --git a/proto.h b/proto.h
index 2f8e2eb..64d71f3 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4681,7 +4681,7 @@ PERL_CALLCONV void        Perl_emulate_cop_io(pTHX_ const COP *const c, SV *const sv)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 
-PERL_CALLCONV regexp * Perl_get_re_arg(pTHX_ SV *sv, U32 flags, MAGIC **mgp);
+PERL_CALLCONV REGEXP * Perl_get_re_arg(pTHX_ SV *sv);
 
 PERL_CALLCONV struct mro_meta* Perl_mro_meta_init(pTHX_ HV* stash)
                        __attribute__nonnull__(pTHX_1);

diff --git a/regexp.h b/regexp.h
index 1353a92..3ec8fb4 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -181,6 +181,41 @@ typedef struct regexp_engine {
 #define RXf_HASH_REGNAMES        0x0800
 #define RXf_HASH_REGNAMES_COUNT  0x1000 
 
+/*
+=head1 REGEXP Functions
+
+=for apidoc Am|REGEXP *|SvRX|SV *sv
+
+Convenience macro to get the REGEXP from a SV. This is approximately
+equivalent to the following snippet:
+
+    if (SvMAGICAL(sv))
+        mg_get(sv);
+    if (SvROK(sv) &&
+        (tmpsv = (SV*)SvRV(sv)) &&
+        SvTYPE(tmpsv) == SVt_PVMG &&
+        (tmpmg = mg_find(tmpsv, PERL_MAGIC_qr)))
+    {
+        return (REGEXP *)tmpmg->mg_obj;
+    }
+
+NULL will be returned if a REGEXP* is not found.
+
+=for apidoc Am|bool|SvRXOK|SV* sv
+
+Returns a boolean indicating whether the SV contains qr magic
+(PERL_MAGIC_qr).
+
+If you want to do something with the REGEXP* later use SvRX instead
+and check for NULL.
+
+=cut
+*/
+
+#define SvRX(sv)   (Perl_get_re_arg(aTHX_ sv))
+#define SvRXOK(sv) (Perl_get_re_arg(aTHX_ sv) ? TRUE : FALSE)
+
+
 /* Flags stored in regexp->extflags 
  * These are used by code external to the regexp engine
  *

diff --git a/universal.c b/universal.c
index 01e2fe4..2b39583 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -176,26 +176,6 @@ Perl_sv_does(pTHX_ SV *sv, const char *name)
     return does_it;
 }
 
-regexp *
-Perl_get_re_arg( pTHX_ SV *sv, U32 flags, MAGIC **mgp) {
-    MAGIC *mg;
-    if (sv) {
-        if (SvMAGICAL(sv))
-            mg_get(sv);
-        if (SvROK(sv) &&
-            (sv = (SV*)SvRV(sv)) &&     /* assign deliberate */
-            SvTYPE(sv) == SVt_PVMG &&
-            (mg = mg_find(sv, PERL_MAGIC_qr))) /* assign deliberate */
-        {        
-            if (mgp) *mgp = mg;
-            return (regexp *)mg->mg_obj;       
-        }
-    }    
-    if (mgp) *mgp = NULL;
-    return ((flags && PL_curpm) ? PM_GETRE(PL_curpm) : NULL);
-}
-
-
 PERL_XS_EXPORT_C void XS_UNIVERSAL_isa(pTHX_ CV *cv);
 PERL_XS_EXPORT_C void XS_UNIVERSAL_can(pTHX_ CV *cv);
 PERL_XS_EXPORT_C void XS_UNIVERSAL_DOES(pTHX_ CV *cv);
@@ -1075,22 +1055,17 @@ XS(XS_re_is_regexp)
 {
     dVAR; 
     dXSARGS;
+    PERL_UNUSED_VAR(cv);
+
     if (items != 1)
        Perl_croak(aTHX_ "Usage: %s(%s)", "re::is_regexp", "sv");
-    PERL_UNUSED_VAR(cv); /* -W */
-    PERL_UNUSED_VAR(ax); /* -Wall */
+
     SP -= items;
-    {
-       SV *    sv = ST(0);
-        if ( Perl_get_re_arg( aTHX_ sv, 0, NULL ) ) 
-        {
-            XSRETURN_YES;
-        } else {
-            XSRETURN_NO;
-        }
-        /* NOTREACHED */        
-       PUTBACK;
-       return;
+
+    if (SvRXOK(ST(0))) {
+        XSRETURN_YES;
+    } else {
+        XSRETURN_NO;
     }
 }
 

diff --git a/util.c b/util.c
index 058d0c2..dffe6f4 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5871,6 +5871,26 @@ Perl_my_dirfd(pTHX_ DIR * dir) {
 #endif 
 }
 
+REGEXP *
+Perl_get_re_arg(pTHX_ SV *sv) {
+    SV    *tmpsv;
+    MAGIC *mg;
+
+    if (sv) {
+        if (SvMAGICAL(sv))
+            mg_get(sv);
+        if (SvROK(sv) &&
+            (tmpsv = (SV*)SvRV(sv)) &&            /* assign deliberate */
+            SvTYPE(tmpsv) == SVt_PVMG &&
+            (mg = mg_find(tmpsv, PERL_MAGIC_qr))) /* assign deliberate */
+        {
+            return (REGEXP *)mg->mg_obj;
+        }
+    }
+ 
+    return NULL;
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd