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>

diff --git a/sv.c b/sv.c
index ae97f1d..cf29ffa 100644 (file)
--- a/sv.c
+++ b/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),

diff --git a/universal.c b/universal.c
index 563761e..a109e7d 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -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;

diff --git a/util.c b/util.c
index 052cb2c..316b1cc 100644 (file)
--- a/util.c
+++ b/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) ) {