/* util.c
*
- * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
+ * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
+ * 2002, 2003, 2004, 2005, 2006, 2007, 2008 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.
*/
/*
- * "Very useful, no doubt, that was to Saruman; yet it seems that he was
- * not content." --Gandalf
+ * 'Very useful, no doubt, that was to Saruman; yet it seems that he was
+ * not content.' --Gandalf to Pippin
+ *
+ * [p.598 of _The Lord of the Rings_, III/xi: "The PalantÃr"]
*/
/* This file contains assorted utility routines.
if (size && (count <= MEM_SIZE_MAX / size))
total_size = size * count;
else
- Perl_croak_nocontext(PL_memory_wrap);
+ Perl_croak_nocontext("%s", PL_memory_wrap);
#ifdef PERL_TRACK_MEMPOOL
if (sTHX <= MEM_SIZE_MAX - (MEM_SIZE)total_size)
total_size += sTHX;
else
- Perl_croak_nocontext(PL_memory_wrap);
+ Perl_croak_nocontext("%s", PL_memory_wrap);
#endif
#ifdef HAS_64K_LIMIT
if (total_size > 0xffff) {
if (PL_stderrgv && SvREFCNT(PL_stderrgv)
&& (io = GvIO(PL_stderrgv))
- && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
{
dSP;
ENTER;
PUSHMARK(SP);
EXTEND(SP,2);
- PUSHs(SvTIED_obj((SV*)io, mg));
+ PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
mPUSHp(message, msglen);
PUTBACK;
call_method("PRINT", G_SCALAR);
PUSHMARK(SP);
XPUSHs(msg);
PUTBACK;
- call_sv((SV*)cv, G_DISCARD);
+ call_sv(MUTABLE_SV(cv), G_DISCARD);
POPSTACK;
LEAVE;
return TRUE;
if (strNE(a,b))
return FALSE;
if (fa == a)
- sv_setpvn(tmpsv, ".", 1);
+ sv_setpvs(tmpsv, ".");
else
sv_setpvn(tmpsv, a, fa - a);
if (PerlLIO_stat(SvPVX_const(tmpsv), &tmpstatbuf1) < 0)
return FALSE;
if (fb == b)
- sv_setpvn(tmpsv, ".", 1);
+ sv_setpvs(tmpsv, ".");
else
sv_setpvn(tmpsv, b, fb - b);
if (PerlLIO_stat(SvPVX_const(tmpsv), &tmpstatbuf2) < 0)
pos = s;
if ( qv )
- (void)hv_stores((HV *)hv, "qv", newSViv(qv));
+ (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(qv));
if ( alpha )
- (void)hv_stores((HV *)hv, "alpha", newSViv(alpha));
+ (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(alpha));
if ( !qv && width < 3 )
- (void)hv_stores((HV *)hv, "width", newSViv(width));
+ (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
while (isDIGIT(*pos))
pos++;
Compiler in question is:
gcc version 3.3 20030304 (Apple Computer, Inc. build 1640)
for ( len = 2 - len; len > 0; len-- )
- av_push((AV *)sv, newSViv(0));
+ av_push(MUTABLE_AV(sv), newSViv(0));
*/
len = 2 - len;
while (len-- > 0)
/* need to save off the current version string for later */
if ( vinf ) {
SV * orig = newSVpvn("v.Inf", sizeof("v.Inf")-1);
- (void)hv_stores((HV *)hv, "original", orig);
- (void)hv_stores((HV *)hv, "vinf", newSViv(1));
+ (void)hv_stores(MUTABLE_HV(hv), "original", orig);
+ (void)hv_stores(MUTABLE_HV(hv), "vinf", newSViv(1));
}
else if ( s > start ) {
SV * orig = newSVpvn(start,s-start);
/* need to insert a v to be consistent */
sv_insert(orig, 0, 0, "v", 1);
}
- (void)hv_stores((HV *)hv, "original", orig);
+ (void)hv_stores(MUTABLE_HV(hv), "original", orig);
}
else {
- (void)hv_stores((HV *)hv, "original", newSVpvn("0",1));
+ (void)hv_stores(MUTABLE_HV(hv), "original", newSVpvs("0"));
av_push(av, newSViv(0));
}
/* And finally, store the AV in the hash */
- (void)hv_stores((HV *)hv, "version", newRV_noinc((SV *)av));
+ (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av)));
/* fix RT#19517 - special case 'undef' as string */
if ( *s == 'u' && strEQ(s,"undef") ) {
ver = SvRV(ver);
/* Begin copying all of the elements */
- if ( hv_exists((HV *)ver, "qv", 2) )
- (void)hv_stores((HV *)hv, "qv", newSViv(1));
+ if ( hv_exists(MUTABLE_HV(ver), "qv", 2) )
+ (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(1));
- if ( hv_exists((HV *)ver, "alpha", 5) )
- (void)hv_stores((HV *)hv, "alpha", newSViv(1));
+ if ( hv_exists(MUTABLE_HV(ver), "alpha", 5) )
+ (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(1));
- if ( hv_exists((HV*)ver, "width", 5 ) )
+ if ( hv_exists(MUTABLE_HV(ver), "width", 5 ) )
{
- const I32 width = SvIV(*hv_fetchs((HV*)ver, "width", FALSE));
- (void)hv_stores((HV *)hv, "width", newSViv(width));
+ const I32 width = SvIV(*hv_fetchs(MUTABLE_HV(ver), "width", FALSE));
+ (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
}
- if ( hv_exists((HV*)ver, "original", 8 ) )
+ if ( hv_exists(MUTABLE_HV(ver), "original", 8 ) )
{
- SV * pv = *hv_fetchs((HV*)ver, "original", FALSE);
- (void)hv_stores((HV *)hv, "original", newSVsv(pv));
+ SV * pv = *hv_fetchs(MUTABLE_HV(ver), "original", FALSE);
+ (void)hv_stores(MUTABLE_HV(hv), "original", newSVsv(pv));
}
- sav = (AV *)SvRV(*hv_fetchs((HV*)ver, "version", FALSE));
+ sav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(ver), "version", FALSE)));
/* This will get reblessed later if a derived class*/
for ( key = 0; key <= av_len(sav); key++ )
{
av_push(av, newSViv(rev));
}
- (void)hv_stores((HV *)hv, "version", newRV_noinc((SV *)av));
+ (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av)));
return rv;
}
#ifdef SvVOK
/* see if the appropriate elements exist */
if ( SvTYPE(vs) == SVt_PVHV
- && hv_exists((HV*)vs, "version", 7)
- && (sv = SvRV(*hv_fetchs((HV*)vs, "version", FALSE)))
+ && hv_exists(MUTABLE_HV(vs), "version", 7)
+ && (sv = SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE)))
&& SvTYPE(sv) == SVt_PVAV )
return TRUE;
else
Perl_croak(aTHX_ "Invalid version object");
/* see if various flags exist */
- if ( hv_exists((HV*)vs, "alpha", 5 ) )
+ if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) )
alpha = TRUE;
- if ( hv_exists((HV*)vs, "width", 5 ) )
- width = SvIV(*hv_fetchs((HV*)vs, "width", FALSE));
+ if ( hv_exists(MUTABLE_HV(vs), "width", 5 ) )
+ width = SvIV(*hv_fetchs(MUTABLE_HV(vs), "width", FALSE));
else
width = 3;
/* attempt to retrieve the version array */
- if ( !(av = (AV *)SvRV(*hv_fetchs((HV*)vs, "version", FALSE)) ) ) {
+ if ( !(av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))) ) ) {
sv_catpvs(sv,"0");
return sv;
}
if ( !vverify(vs) )
Perl_croak(aTHX_ "Invalid version object");
- if ( hv_exists((HV*)vs, "alpha", 5 ) )
+ if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) )
alpha = TRUE;
- av = (AV *)SvRV(*hv_fetchs((HV*)vs, "version", FALSE));
+ av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE)));
len = av_len(av);
if ( len == -1 )
if ( !vverify(vs) )
Perl_croak(aTHX_ "Invalid version object");
- if (hv_exists((HV*)vs, "original", sizeof("original") - 1)) {
+ if (hv_exists(MUTABLE_HV(vs), "original", sizeof("original") - 1)) {
SV *pv;
- pv = *hv_fetchs((HV*)vs, "original", FALSE);
+ pv = *hv_fetchs(MUTABLE_HV(vs), "original", FALSE);
if ( SvPOK(pv) )
return newSVsv(pv);
else
return &PL_sv_undef;
}
else {
- if ( hv_exists((HV *)vs, "qv", 2) )
+ if ( hv_exists(MUTABLE_HV(vs), "qv", 2) )
return vnormal(vs);
else
return vnumify(vs);
Perl_croak(aTHX_ "Invalid version object");
/* get the left hand term */
- lav = (AV *)SvRV(*hv_fetchs((HV*)lhv, "version", FALSE));
- if ( hv_exists((HV*)lhv, "alpha", 5 ) )
+ lav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(lhv), "version", FALSE)));
+ if ( hv_exists(MUTABLE_HV(lhv), "alpha", 5 ) )
lalpha = TRUE;
/* and the right hand term */
- rav = (AV *)SvRV(*hv_fetchs((HV*)rhv, "version", FALSE));
- if ( hv_exists((HV*)rhv, "alpha", 5 ) )
+ rav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(rhv), "version", FALSE)));
+ if ( hv_exists(MUTABLE_HV(rhv), "alpha", 5 ) )
ralpha = TRUE;
l = av_len(lav);
if ( svp && ((CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
|| strEQ(GvNAME(gv), "END")
|| ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
- !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) )))) {
+ !( (SvTYPE(*svp) == SVt_PVGV)
+ && (GvCV((const GV *)*svp) == cv) )))) {
/* Use GV from the stack as a fallback. */
/* GV is potentially non-unique, or contain different CV. */
- SV * const tmp = newRV((SV*)cv);
+ SV * const tmp = newRV(MUTABLE_SV(cv));
sv_setsv(dbsv, tmp);
SvREFCNT_dec(tmp);
}
if (SvMAGICAL(sv))
mg_get(sv);
if (SvROK(sv) &&
- (tmpsv = (SV*)SvRV(sv)) && /* assign deliberate */
+ (tmpsv = MUTABLE_SV(SvRV(sv))) && /* assign deliberate */
SvTYPE(tmpsv) == SVt_REGEXP)
{
return (REGEXP*) tmpsv;
projects / p5sagit/p5-mst-13.2.git / blobdiff