From: Ævar Arnfjörð Bjarmason Date: Mon, 18 Jun 2007 03:33:34 +0000 (+0000) Subject: SvRX() and SvRXOK() macros X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f7e711955148e1ce710988aa3010c41ca8085a03;p=p5sagit%2Fp5-mst-13.2.git SvRX() and SvRXOK() macros From: "Ævar Arnfjörð Bjarmason" Message-ID: <51dd1af80706172033h1908aa0ge15698204e0b79ed@mail.gmail.com> p4raw-id: //depot/perl@31409 --- diff --git a/embed.fnc b/embed.fnc index ef1d961..3939155 100644 --- 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 --- 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 --- 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 + +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 + +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 --- 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 object from the scalar in an XS function use the -following snippet: +To retrieve the C object from the scalar in an XS function use +the C 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 --- 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 --- 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 --- 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 --- 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