diff options
| author | John Peacock <jpeacock@jpeacock-hp.doesntexist.org> | 2010-03-23 22:34:26 -0400 |
|---|---|---|
| committer | Jesse Vincent <jesse@bestpractical.com> | 2010-06-28 22:30:05 -0400 |
| commit | d808b6810e2e80e71657bdc95f0a5a577b30e300 (patch) | |
| tree | 2a1ae4701eccf8714162c14ea20b483743eee821 /universal.c | |
| parent | aa78b6614081231ad68f121592365c3c2623bf3d (diff) | |
| download | perl-d808b6810e2e80e71657bdc95f0a5a577b30e300.tar.gz | |
Prevent object methods called as class methods
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.
Diffstat (limited to 'universal.c')
| -rw-r--r-- | universal.c | 32 |
1 files changed, 16 insertions, 16 deletions
diff --git a/universal.c b/universal.c index 1190e9716f..2f73dd06cb 100644 --- a/universal.c +++ b/universal.c @@ -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; |