/* 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.
*/
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;
/* 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);
&& (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);
}
}
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)) {
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
pkg = SvSTASH(sv);
}
else {
- pkg = gv_stashsv(sv, FALSE);
+ pkg = gv_stashsv(sv, 0);
}
if (pkg) {
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;
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") ) {
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;
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
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++;