Change 31409 by [EMAIL PROTECTED] on 2007/06/18 07:39:35
Subject: [PATCH] SvRX() and SvRXOK() macros
From: "=?UTF-8?Q?=C3=86var_Arnfj=C3=B6r=C3=B0_Bjarmason?=" <[EMAIL
PROTECTED]>
Date: Mon, 18 Jun 2007 03:33:34 +0000
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/embed.fnc#503 edit
... //depot/perl/ext/re/re.xs#50 edit
... //depot/perl/pod/perlapi.pod#296 edit
... //depot/perl/pod/perlreapi.pod#7 edit
... //depot/perl/proto.h#840 edit
... //depot/perl/regexp.h#104 edit
... //depot/perl/universal.c#175 edit
... //depot/perl/util.c#631 edit
Differences ...
==== //depot/perl/embed.fnc#503 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#502~31388~ 2007-06-15 04:17:50.000000000 -0700
+++ perl/embed.fnc 2007-06-18 00:39:35.000000000 -0700
@@ -1871,7 +1871,7 @@
#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)
==== //depot/perl/ext/re/re.xs#50 (text) ====
Index: perl/ext/re/re.xs
--- perl/ext/re/re.xs#49~31341~ 2007-06-06 07:42:01.000000000 -0700
+++ perl/ext/re/re.xs 2007-06-18 00:39:35.000000000 -0700
@@ -61,25 +61,6 @@
#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 @@
SV * sv
PROTOTYPE: $
PREINIT:
- MAGIC *mg;
REGEXP *re;
PPCODE:
{
@@ -110,7 +90,7 @@
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 @@
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;
==== //depot/perl/pod/perlapi.pod#296 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod#295~31245~ 2007-05-20 16:10:15.000000000 -0700
+++ perl/pod/perlapi.pod 2007-06-18 00:39:35.000000000 -0700
@@ -3135,6 +3135,50 @@
=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
==== //depot/perl/pod/perlreapi.pod#7 (text) ====
Index: perl/pod/perlreapi.pod
--- perl/pod/perlreapi.pod#6~31341~ 2007-06-06 07:42:01.000000000 -0700
+++ perl/pod/perlreapi.pod 2007-06-18 00:39:35.000000000 -0700
@@ -378,23 +378,13 @@
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
==== //depot/perl/proto.h#840 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#839~31388~ 2007-06-15 04:17:50.000000000 -0700
+++ perl/proto.h 2007-06-18 00:39:35.000000000 -0700
@@ -4681,7 +4681,7 @@
__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);
==== //depot/perl/regexp.h#104 (text) ====
Index: perl/regexp.h
--- perl/regexp.h#103~31341~ 2007-06-06 07:42:01.000000000 -0700
+++ perl/regexp.h 2007-06-18 00:39:35.000000000 -0700
@@ -181,6 +181,41 @@
#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
*
==== //depot/perl/universal.c#175 (text) ====
Index: perl/universal.c
--- perl/universal.c#174~31358~ 2007-06-08 08:21:24.000000000 -0700
+++ perl/universal.c 2007-06-18 00:39:35.000000000 -0700
@@ -176,26 +176,6 @@
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 @@
{
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;
}
}
==== //depot/perl/util.c#631 (text) ====
Index: perl/util.c
--- perl/util.c#630~31404~ 2007-06-17 07:48:11.000000000 -0700
+++ perl/util.c 2007-06-18 00:39:35.000000000 -0700
@@ -5871,6 +5871,26 @@
#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
End of Patch.
