The last parameter to gv_stashpv/gv_stashpvn/gv_stashsv is a bitmask

[perl5.git] / universal.c

diff --git a/universal.c b/universal.c
index 7cbaaf7..d07ff2f 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -1,7 +1,7 @@
 /*    universal.c
  *
  *    Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- *    2005, 2006, by Larry Wall and others
+ *    2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -32,7 +32,7 @@
  */
 
 STATIC bool
-S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
+S_isa_lookup(pTHX_ HV *stash, const char *name, const HV* const name_stash,
              int len, int level)
 {
     dVAR;
@@ -45,7 +45,7 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
 
     /* A stash/class can go by many names (ie. User == main::User), so 
        we compare the stash itself just in case */
-    if (name_stash && (stash == name_stash))
+    if (name_stash && ((const HV *)stash == name_stash))
         return TRUE;
 
     hvname = HvNAME_get(stash);
@@ -66,11 +66,14 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
        && (hv = GvHV(gv)))
     {
        if (SvIV(subgen) == (IV)PL_sub_generation) {
-           SV* sv;
            SV** const svp = (SV**)hv_fetch(hv, name, len, FALSE);
-           if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
-               DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
-                                 name, hvname) );
+           if (svp) {
+               SV * const sv = *svp;
+#ifdef DEBUGGING
+               if (sv != &PL_sv_undef)
+                   DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
+                                   name, hvname) );
+#endif
                return (sv == &PL_sv_yes);
            }
        }
@@ -106,12 +109,12 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
            I32 items = AvFILLp(av) + 1;
            while (items--) {
                SV* const sv = *svp++;
-               HV* const basestash = gv_stashsv(sv, FALSE);
+               HV* const basestash = gv_stashsv(sv, 0);
                if (!basestash) {
                    if (ckWARN(WARN_MISC))
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                                    "Can't locate package %"SVf" for @%s::ISA",
-                                   (void*)sv, hvname);
+                                   SVfARG(sv), hvname);
                    continue;
                }
                if (isa_lookup(basestash, name, name_stash, len, level + 1)) {
@@ -154,11 +157,11 @@ Perl_sv_derived_from(pTHX_ SV *sv, const char *name)
        stash = SvOBJECT(sv) ? SvSTASH(sv) : NULL;
     }
     else {
-        stash = gv_stashsv(sv, FALSE);
+        stash = gv_stashsv(sv, 0);
     }
 
     if (stash) {
-       HV * const name_stash = gv_stashpv(name, FALSE);
+       HV * const name_stash = gv_stashpv(name, 0);
        return isa_lookup(stash, name, name_stash, strlen(name), 0);
     }
     else
@@ -359,7 +362,7 @@ XS(XS_UNIVERSAL_can)
             pkg = SvSTASH(sv);
     }
     else {
-        pkg = gv_stashsv(sv, FALSE);
+        pkg = gv_stashsv(sv, 0);
     }
 
     if (pkg) {
@@ -408,7 +411,7 @@ XS(XS_UNIVERSAL_VERSION)
         pkg = SvSTASH(sv);
     }
     else {
-        pkg = gv_stashsv(ST(0), FALSE);
+        pkg = gv_stashsv(ST(0), 0);
     }
 
     gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
@@ -453,10 +456,10 @@ XS(XS_UNIVERSAL_VERSION)
        if ( vcmp( req, sv ) > 0 )
            Perl_croak(aTHX_ "%s version %"SVf" (%"SVf") required--"
                       "this is only version %"SVf" (%"SVf")", HvNAME_get(pkg),
-                      (void*)vnumify(req),
-                      (void*)vnormal(req),
-                      (void*)vnumify(sv),
-                      (void*)vnormal(sv));
+                      SVfARG(vnumify(req)),
+                      SVfARG(vnormal(req)),
+                      SVfARG(vnumify(sv)),
+                      SVfARG(vnormal(sv)));
     }
 
     if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
@@ -495,7 +498,7 @@ XS(XS_version_new)
 
        rv = new_version(vs);
        if ( strcmp(classname,"version") != 0 ) /* inherited new() */
-           sv_bless(rv, gv_stashpv(classname,TRUE));
+           sv_bless(rv, gv_stashpv(classname, GV_ADD));
 
        PUSHs(sv_2mortal(rv));
        PUTBACK;
@@ -685,7 +688,14 @@ XS(XS_version_qv)
            if ( SvNOK(ver) ) /* may get too much accuracy */
            {
                char tbuf[64];
-               const STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVgf, SvNVX(ver));
+#ifdef USE_LOCALE_NUMERIC
+               char *loc = setlocale(LC_NUMERIC, "C");
+#endif
+               STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVgf, SvNVX(ver));
+#ifdef USE_LOCALE_NUMERIC
+               setlocale(LC_NUMERIC, loc);
+#endif
+               while (tbuf[len-1] == '0' && len > 0) len--;
                version = savepvn(tbuf, len);
            }
            else
@@ -983,11 +993,11 @@ XS(XS_PerlIO_get_layers)
                  else {
                       if (namok && argok)
                            XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
-                                                (void*)*namsvp,
-                                                (void*)*argsvp));
+                                                SVfARG(*namsvp),
+                                                SVfARG(*argsvp)));
                       else if (namok)
                            XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf,
-                                                (void*)*namsvp));
+                                                SVfARG(*namsvp)));
                       else
                            XPUSHs(&PL_sv_undef);
                       nitem++;