Permalink
Browse files

Use syntax from perlguts for testing objects

The following paragraph is in perlguts.pod:

   To check if you've got an object derived from a specific class you have
   to write:

       if (sv_isobject(sv) && sv_derived_from(sv, class)) { ... }

which does the right thing with magical things like tied scalars.

Signed-off-by: David Golden <dagolden@cpan.org>
  • Loading branch information...
1 parent a97f6d1 commit 573a19fb2c79f41cfc7f3db5a8ad14e14a4dccf9 John Peacock committed with xdg Dec 7, 2011
Showing with 14 additions and 14 deletions.
  1. +1 −1 sv.c
  2. +11 −11 universal.c
  3. +2 −2 util.c
View
2 sv.c
@@ -10354,7 +10354,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
* back into v-string notation and then let the
* vectorize happen normally
*/
- if (sv_derived_from(vecsv, "version") && SvROK(vecsv)) {
+ if (sv_isobject(vecsv) && sv_derived_from(vecsv, "version")) {
char *version = savesvpv(vecsv);
if ( hv_exists(MUTABLE_HV(SvRV(vecsv)), "alpha", 5 ) ) {
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
View
@@ -425,7 +425,7 @@ XS(XS_UNIVERSAL_VERSION)
SV * const nsv = sv_newmortal();
sv_setsv(nsv, sv);
sv = nsv;
- if ( !sv_derived_from(sv, "version") || !SvROK(sv))
+ if ( !sv_isobject(sv) || !sv_derived_from(sv, "version"))
upg_version(sv, FALSE);
undef = NULL;
@@ -452,7 +452,7 @@ XS(XS_UNIVERSAL_VERSION)
}
}
- if ( !sv_derived_from(req, "version") || !SvROK(req)) {
+ if ( !sv_isobject(req) || !sv_derived_from(req, "version")) {
/* req may very well be R/O, so create a new object */
req = sv_2mortal( new_version(req) );
}
@@ -538,7 +538,7 @@ XS(XS_version_stringify)
{
SV * lobj = ST(0);
- if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+ if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
lobj = SvRV(lobj);
}
else
@@ -561,7 +561,7 @@ XS(XS_version_numify)
{
SV * lobj = ST(0);
- if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+ if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
lobj = SvRV(lobj);
}
else
@@ -584,7 +584,7 @@ XS(XS_version_normal)
{
SV * lobj = ST(0);
- if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+ if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
lobj = SvRV(lobj);
}
else
@@ -607,7 +607,7 @@ XS(XS_version_vcmp)
{
SV * lobj = ST(0);
- if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+ if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
lobj = SvRV(lobj);
}
else
@@ -619,7 +619,7 @@ XS(XS_version_vcmp)
SV * robj = ST(1);
const IV swap = (IV)SvIV(ST(2));
- if ( ! sv_derived_from(robj, "version") || !SvROK(robj) )
+ if ( !sv_isobject(robj) || !sv_derived_from(robj, "version") )
{
robj = new_version(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
sv_2mortal(robj);
@@ -650,7 +650,7 @@ XS(XS_version_boolean)
if (items < 1)
croak_xs_usage(cv, "lobj, ...");
SP -= items;
- if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
+ if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version")) {
SV * const lobj = SvRV(ST(0));
SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
mPUSHs(rs);
@@ -667,7 +667,7 @@ XS(XS_version_noop)
dXSARGS;
if (items < 1)
croak_xs_usage(cv, "lobj, ...");
- if (sv_derived_from(ST(0), "version") && SvROK(ST(0)))
+ if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version"))
Perl_croak(aTHX_ "operation not supported with version object");
else
Perl_croak(aTHX_ "lobj is not of type version");
@@ -683,7 +683,7 @@ XS(XS_version_is_alpha)
if (items != 1)
croak_xs_usage(cv, "lobj");
SP -= items;
- if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
+ if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version")) {
SV * const lobj = ST(0);
if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "alpha", 5 ) )
XSRETURN_YES;
@@ -745,7 +745,7 @@ XS(XS_version_is_qv)
if (items != 1)
croak_xs_usage(cv, "lobj");
SP -= items;
- if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
+ if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version")) {
SV * const lobj = ST(0);
if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "qv", 2 ) )
XSRETURN_YES;
View
4 util.c
@@ -4857,7 +4857,7 @@ Perl_new_version(pTHX_ SV *ver)
dVAR;
SV * const rv = newSV(0);
PERL_ARGS_ASSERT_NEW_VERSION;
- if ( sv_derived_from(ver,"version") && SvROK(ver) )
+ if ( sv_isobject(ver) && sv_derived_from(ver, "version") )
/* can just copy directly */
{
I32 key;
@@ -6430,7 +6430,7 @@ Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p,
}
if (sv) {
SV *xssv = Perl_newSVpvn_flags(aTHX_ xs_p, xs_len, SVs_TEMP);
- SV *pmsv = sv_derived_from(sv, "version") && SvROK(sv)
+ SV *pmsv = sv_isobject(sv) && sv_derived_from(sv, "version")
? sv : sv_2mortal(new_version(sv));
xssv = upg_version(xssv, 0);
if ( vcmp(pmsv,xssv) ) {

0 comments on commit 573a19f

Please sign in to comment.