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>

3 files changed, 14 insertions, 14 deletions

diff --git a/sv.c b/sv.c
index ae97f1d6a2..cf29ffad54 100644
--- 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 563761eb83..a109e7d2fe 100644
--- 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 052cb2c87e..316b1cc524 100644
--- 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) ) {