This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Prevent object methods called as class methods
authorJohn Peacock <jpeacock@jpeacock-hp.doesntexist.org>
Wed, 24 Mar 2010 02:34:26 +0000 (22:34 -0400)
committerJesse Vincent <jesse@bestpractical.com>
Tue, 29 Jun 2010 02:30:05 +0000 (22:30 -0400)
There are a number of object methods which make absolutely
no sense when called as class methods.  In addition, with
Perl 5.11.5/5.12.0, there are asserts which will trigger
SEGV's when you do that.

So we check in the XS code and refuse to continue if an
object method is called as a class method.

universal.c

index 1190e97..2f73dd0 100644 (file)
@@ -456,10 +456,10 @@ XS(XS_version_stringify)
         croak_xs_usage(cv, "lobj, ...");
      SP -= items;
      {
-         SV *  lobj;
+         SV *  lobj = ST(0);
 
-         if (sv_derived_from(ST(0), "version")) {
-              lobj = SvRV(ST(0));
+         if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+              lobj = SvRV(lobj);
          }
          else
               Perl_croak(aTHX_ "lobj is not of type version");
@@ -479,10 +479,10 @@ XS(XS_version_numify)
         croak_xs_usage(cv, "lobj, ...");
      SP -= items;
      {
-         SV *  lobj;
+         SV *  lobj = ST(0);
 
-         if (sv_derived_from(ST(0), "version")) {
-              lobj = SvRV(ST(0));
+         if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+              lobj = SvRV(lobj);
          }
          else
               Perl_croak(aTHX_ "lobj is not of type version");
@@ -502,10 +502,10 @@ XS(XS_version_normal)
         croak_xs_usage(cv, "lobj, ...");
      SP -= items;
      {
-         SV *  lobj;
+         SV *  lobj = ST(0);
 
-         if (sv_derived_from(ST(0), "version")) {
-              lobj = SvRV(ST(0));
+         if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+              lobj = SvRV(lobj);
          }
          else
               Perl_croak(aTHX_ "lobj is not of type version");
@@ -525,10 +525,10 @@ XS(XS_version_vcmp)
         croak_xs_usage(cv, "lobj, ...");
      SP -= items;
      {
-         SV *  lobj;
+         SV *  lobj = ST(0);
 
-         if (sv_derived_from(ST(0), "version")) {
-              lobj = SvRV(ST(0));
+         if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+              lobj = SvRV(lobj);
          }
          else
               Perl_croak(aTHX_ "lobj is not of type version");
@@ -569,7 +569,7 @@ XS(XS_version_boolean)
     if (items < 1)
        croak_xs_usage(cv, "lobj, ...");
     SP -= items;
-    if (sv_derived_from(ST(0), "version")) {
+    if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
        SV * const lobj = SvRV(ST(0));
        SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
        mPUSHs(rs);
@@ -586,7 +586,7 @@ XS(XS_version_noop)
     dXSARGS;
     if (items < 1)
        croak_xs_usage(cv, "lobj, ...");
-    if (sv_derived_from(ST(0), "version"))
+    if (sv_derived_from(ST(0), "version") && SvROK(ST(0)))
        Perl_croak(aTHX_ "operation not supported with version object");
     else
        Perl_croak(aTHX_ "lobj is not of type version");
@@ -602,7 +602,7 @@ XS(XS_version_is_alpha)
     if (items != 1)
        croak_xs_usage(cv, "lobj");
     SP -= items;
-    if (sv_derived_from(ST(0), "version")) {
+    if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
        SV * const lobj = ST(0);
        if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "alpha", 5 ) )
            XSRETURN_YES;
@@ -656,7 +656,7 @@ XS(XS_version_is_qv)
     if (items != 1)
        croak_xs_usage(cv, "lobj");
     SP -= items;
-    if (sv_derived_from(ST(0), "version")) {
+    if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
        SV * const lobj = ST(0);
        if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "qv", 2 ) )
            XSRETURN_YES;