Upgrade to Encode 1.92.

[p5sagit/p5-mst-13.2.git] / universal.c

diff --git a/universal.c b/universal.c
index 4a879e9..f5ce23e 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -1,6 +1,6 @@
 /*    universal.c
  *
- *    Copyright (c) 1997-2002, Larry Wall
+ *    Copyright (c) 1997-2003, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -94,8 +94,8 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
                if (!basestash) {
                    if (ckWARN(WARN_MISC))
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                            "Can't locate package %s for @%s::ISA",
-                           SvPVX(sv), HvNAME(stash));
+                            "Can't locate package %"SVf" for @%s::ISA",
+                           sv, HvNAME(stash));
                    continue;
                }
                if (&PL_sv_yes == isa_lookup(basestash, name, name_stash, 
@@ -186,12 +186,10 @@ 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);
        newXS("version::(\"\"", XS_version_stringify, file);
        newXS("version::stringify", XS_version_stringify, file);
@@ -234,7 +232,8 @@ XS(XS_UNIVERSAL_isa)
     if (SvGMAGICAL(sv))
        mg_get(sv);
 
-    if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))))
+    if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
+               || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
        XSRETURN_UNDEF;
 
     name = (char *)SvPV(ST(1),n_a);
@@ -260,7 +259,8 @@ XS(XS_UNIVERSAL_can)
     if (SvGMAGICAL(sv))
        mg_get(sv);
 
-    if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))))
+    if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
+               || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
        XSRETURN_UNDEF;
 
     name = (char *)SvPV(ST(1),n_a);
@@ -333,48 +333,18 @@ 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<use Foo v1.2.3> 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<use Foo 1.002_003> 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<use Foo v1.2.3> */
-       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))
-           Perl_croak(aTHX_ "%s version %s required--this is only version %s",
-                      HvNAME(pkg), SvPV_nolen(req), SvPV_nolen(sv));
+       if ( vcmp( SvRV(req), SvRV(sv) ) > 0 )
+           Perl_croak(aTHX_
+               "%s version %"SVf" required--this is only version %"SVf,
+               HvNAME(pkg), req, sv);
     }
 
-finish:
     ST(0) = sv;
 
     XSRETURN(1);
@@ -383,17 +353,19 @@ finish:
 XS(XS_version_new)
 {
     dXSARGS;
-    if (items != 2)
+    if (items > 3)
        Perl_croak(aTHX_ "Usage: version::new(class, version)");
     SP -= items;
     {
 /*     char *  class = (char *)SvPV_nolen(ST(0)); */
-       SV *    version = ST(1);
-
-{
-    PUSHs(new_version(version));
-}
+        SV *version = ST(1);
+       if (items == 3 )
+       {
+           char *vs = savepvn(SvPVX(ST(2)),SvCUR(ST(2)));
+           version = Perl_newSVpvf(aTHX_ "v%s",vs);
+       }
 
+       PUSHs(new_version(version));
        PUTBACK;
        return;
     }
@@ -416,12 +388,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;
@@ -446,9 +413,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;
@@ -486,11 +451,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);
@@ -519,7 +484,7 @@ XS(XS_version_boolean)
 
 {
     SV *rs;
-    rs = newSViv(sv_cmp(lobj,Nullsv));
+    rs = newSViv( vcmp(lobj,new_version(newSVpvn("0",1))) );
     PUSHs(rs);
 }