From ad63d80fcd28c3b5fdbb5328f0f8ea29cbce94d8 Mon Sep 17 00:00:00 2001 From: John Peacock Date: Fri, 4 Oct 2002 19:15:10 -0400 Subject: Version object combined patch Message-ID: <3D9E593E.1060605@rowman.com> p4raw-id: //depot/perl@17990 --- universal.c | 69 +++++++++++++------------------------------------------------ 1 file changed, 14 insertions(+), 55 deletions(-) (limited to 'universal.c') diff --git a/universal.c b/universal.c index 7e80da2e72..533d84399f 100644 --- a/universal.c +++ b/universal.c @@ -186,11 +186,8 @@ Perl_boot_core_UNIVERSAL(pTHX) newXS("UNIVERSAL::can", XS_UNIVERSAL_can, file); newXS("UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, file); { - /* create the package stash for version objects */ - HV *hv = get_hv("version::OVERLOAD",TRUE); - SV *sv = *hv_fetch(hv,"register",8,1); - sv_inc(sv); - SvSETMAGIC(sv); + /* register the overloading (type 'A') magic */ + PL_amagic_generation++; /* Make it findable via fetchmethod */ newXS("version::()", XS_version_noop, file); newXS("version::new", XS_version_new, file); @@ -334,48 +331,17 @@ XS(XS_UNIVERSAL_VERSION) "%s defines neither package nor VERSION--version check failed", str); } } - if (!SvNIOK(sv) && SvPOK(sv)) { - char *str = SvPVx(sv,len); - while (len) { - --len; - /* XXX could DWIM "1.2.3" here */ - if (!isDIGIT(str[len]) && str[len] != '.' && str[len] != '_') - break; - } - if (len) { - if (SvNOK(req) && SvPOK(req)) { - /* they said C and $Foo::VERSION - * doesn't look like a float: do string compare */ - if (sv_cmp(req,sv) == 1) { - Perl_croak(aTHX_ "%s v%"VDf" required--" - "this is only v%"VDf, - HvNAME(pkg), req, sv); - } - goto finish; - } - /* they said C and $Foo::VERSION - * doesn't look like a float: force numeric compare */ - (void)SvUPGRADE(sv, SVt_PVNV); - SvNVX(sv) = str_to_version(sv); - SvPOK_off(sv); - SvNOK_on(sv); - } - } - /* if we get here, we're looking for a numeric comparison, - * so force the required version into a float, even if they - * said C */ - if (SvNOK(req) && SvPOK(req)) { - NV n = SvNV(req); - req = sv_newmortal(); - sv_setnv(req, n); - } + if ( !sv_derived_from(sv, "version")) + sv = new_version(sv); + + if ( !sv_derived_from(req, "version")) + req = new_version(req); - if (SvNV(req) > SvNV(sv)) + if ( vcmp( SvRV(req), SvRV(sv) ) > 0 ) Perl_croak(aTHX_ "%s version %s required--this is only version %s", - HvNAME(pkg), SvPV_nolen(req), SvPV_nolen(sv)); + HvNAME(pkg), SvPV(req,PL_na), SvPV(sv,PL_na)); } -finish: ST(0) = sv; XSRETURN(1); @@ -417,12 +383,7 @@ XS(XS_version_stringify) Perl_croak(aTHX_ "lobj is not of type version"); { - SV *vs = NEWSV(92,5); - if ( lobj == SvRV(PL_patchlevel) ) - sv_catsv(vs,lobj); - else - vstringify(vs,lobj); - PUSHs(vs); + PUSHs(vstringify(lobj)); } PUTBACK; @@ -447,9 +408,7 @@ XS(XS_version_numify) Perl_croak(aTHX_ "lobj is not of type version"); { - SV *vs = NEWSV(92,5); - vnumify(vs,lobj); - PUSHs(vs); + PUSHs(vnumify(lobj)); } PUTBACK; @@ -487,11 +446,11 @@ XS(XS_version_vcmp) if ( swap ) { - rs = newSViv(sv_cmp(rvs,lobj)); + rs = newSViv(vcmp(rvs,lobj)); } else { - rs = newSViv(sv_cmp(lobj,rvs)); + rs = newSViv(vcmp(lobj,rvs)); } PUSHs(rs); @@ -520,7 +479,7 @@ XS(XS_version_boolean) { SV *rs; - rs = newSViv(sv_cmp(lobj,Nullsv)); + rs = newSViv( vcmp(lobj,new_version(newSVpvn("0",1))) ); PUSHs(rs); } -- cgit v1.2.1