static char *
uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
{
- STRLEN len;
char *ptr = buf + TYPE_CHARS(UV);
char *ebuf = ptr;
int sign;
- char *p;
if (is_uv)
sign = 0;
int right = 4;
U16 reganch = (re->reganch & PMf_COMPILETIME) >> 12;
- while(ch = *fptr++) {
+ while((ch = *fptr++)) {
if(reganch & 1) {
reflags[left++] = ch;
}
else
dref = (SV*)GvAV(dstr);
GvAV(dstr) = (AV*)sref;
- if (GvIMPORTED_AV_off(dstr)
+ if (!GvIMPORTED_AV(dstr)
&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_AV_on(dstr);
else
dref = (SV*)GvHV(dstr);
GvHV(dstr) = (HV*)sref;
- if (GvIMPORTED_HV_off(dstr)
+ if (!GvIMPORTED_HV(dstr)
&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_HV_on(dstr);
GvASSUMECV_on(dstr);
PL_sub_generation++;
}
- if (GvIMPORTED_CV_off(dstr)
+ if (!GvIMPORTED_CV(dstr)
&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_CV_on(dstr);
else
dref = (SV*)GvSV(dstr);
GvSV(dstr) = sref;
- if (GvIMPORTED_SV_off(dstr)
+ if (!GvIMPORTED_SV(dstr)
&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_SV_on(dstr);
SvPV_set(dstr, SvPVX(sstr));
SvLEN_set(dstr, SvLEN(sstr));
SvCUR_set(dstr, SvCUR(sstr));
+ if (SvUTF8(sstr))
+ SvUTF8_on(dstr);
+ else
+ SvUTF8_off(dstr);
+
SvTEMP_off(dstr);
(void)SvOK_off(sstr);
SvPV_set(sstr, Nullch);
STRLEN len;
if (!sstr)
return;
- if (s = SvPV(sstr, len)) {
+ if ((s = SvPV(sstr, len))) {
if (SvUTF8(sstr))
sv_utf8_upgrade(dstr);
sv_catpvn(dstr,s,len);
SvCUR_set(bigstr, mid - big);
}
/*SUPPRESS 560*/
- else if (i = mid - big) { /* faster from front */
+ else if ((i = mid - big)) { /* faster from front */
midend -= littlelen;
mid = midend;
sv_chop(bigstr,midend-i);
STRLEN cur1, cur2;
char *pv1, *pv2;
I32 retval;
- bool utf1;
if (str1) {
pv1 = SvPV(str1, cur1);
{
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
MAGIC *mg = mg_find(sv, 't');
- if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv))
+ if (mg && ((mg->mg_len & 1) || ((mg->mg_len & 2) && mg->mg_obj == sv)))
return TRUE;
}
return FALSE;
for (p = (char*)pat; p < patend; p = q) {
bool alt = FALSE;
bool left = FALSE;
+ bool vectorize = FALSE;
+ bool utf = FALSE;
char fill = ' ';
char plus = 0;
char intsize = 0;
bool is_utf = FALSE;
char esignbuf[4];
- U8 utf8buf[10];
+ U8 utf8buf[UTF8_MAXLEN];
STRLEN esignlen = 0;
char *eptr = Nullch;
char ebuf[IV_DIG * 4 + NV_DIG + 32];
/* large enough for "%#.#f" --chip */
/* what about long double NVs? --jhi */
+
+ SV *vecsv;
+ U8 *vecstr = Null(U8*);
+ STRLEN veclen = 0;
char c;
int i;
unsigned base;
STRLEN have;
STRLEN need;
STRLEN gap;
+ char *dotstr = ".";
+ STRLEN dotstrlen = 1;
for (q = p; q < patend && *q != '%'; ++q) ;
if (q > p) {
q++;
continue;
+ case '*': /* printf("%*vX",":",$ipv6addr) */
+ if (q[1] != 'v')
+ break;
+ q++;
+ if (args)
+ vecsv = va_arg(*args, SV*);
+ else if (svix < svmax)
+ vecsv = svargs[svix++];
+ dotstr = SvPVx(vecsv,dotstrlen);
+ if (DO_UTF8(vecsv))
+ is_utf = TRUE;
+ /* FALL THROUGH */
+
+ case 'v':
+ vectorize = TRUE;
+ q++;
+ if (args)
+ vecsv = va_arg(*args, SV*);
+ else if (svix < svmax)
+ vecsv = svargs[svix++];
+ vecstr = (U8*)SvPVx(vecsv,veclen);
+ utf = DO_UTF8(vecsv);
+ continue;
+
default:
break;
}
}
goto string;
- case 'v':
- if (args)
- argsv = va_arg(*args, SV*);
- else if (svix < svmax)
- argsv = svargs[svix++];
- {
- STRLEN len;
- U8 *str = (U8*)SvPVx(argsv,len);
- I32 vlen = len*3+1;
- SV *vsv = NEWSV(73,vlen);
- I32 ulen;
- I32 vfree = vlen;
- U8 *vptr = (U8*)SvPVX(vsv);
- STRLEN vcur = 0;
- bool utf = DO_UTF8(argsv);
-
- if (utf)
- is_utf = TRUE;
- while (len) {
- UV uv;
-
- if (utf)
- uv = utf8_to_uv(str, &ulen);
- else {
- uv = *str;
- ulen = 1;
- }
- str += ulen;
- len -= ulen;
- eptr = ebuf + sizeof ebuf;
- do {
- *--eptr = '0' + uv % 10;
- } while (uv /= 10);
- elen = (ebuf + sizeof ebuf) - eptr;
- while (elen >= vfree-1) {
- STRLEN off = vptr - (U8*)SvPVX(vsv);
- vfree += vlen;
- vlen *= 2;
- SvGROW(vsv, vlen);
- vptr = (U8*)SvPVX(vsv) + off;
- }
- memcpy(vptr, eptr, elen);
- vptr += elen;
- *vptr++ = '.';
- vfree -= elen + 1;
- vcur += elen + 1;
- }
- if (vcur) {
- vcur--;
- vptr[-1] = '\0';
- }
- SvCUR_set(vsv,vcur);
- eptr = SvPVX(vsv);
- elen = vcur;
- }
- goto string;
-
case '_':
/*
* The "%_" hack might have to be changed someday,
is_utf = TRUE;
string:
+ vectorize = FALSE;
if (has_precis && elen > precis)
elen = precis;
break;
/* FALL THROUGH */
case 'd':
case 'i':
- if (args) {
+ if (vectorize) {
+ I32 ulen;
+ if (!veclen) {
+ vectorize = FALSE;
+ break;
+ }
+ if (utf)
+ iv = (IV)utf8_to_uv(vecstr, &ulen);
+ else {
+ iv = *vecstr;
+ ulen = 1;
+ }
+ vecstr += ulen;
+ veclen -= ulen;
+ }
+ else if (args) {
switch (intsize) {
case 'h': iv = (short)va_arg(*args, int); break;
default: iv = va_arg(*args, int); break;
base = 16;
uns_integer:
- if (args) {
+ if (vectorize) {
+ I32 ulen;
+ vector:
+ if (!veclen) {
+ vectorize = FALSE;
+ break;
+ }
+ if (utf)
+ uv = utf8_to_uv(vecstr, &ulen);
+ else {
+ uv = *vecstr;
+ ulen = 1;
+ }
+ vecstr += ulen;
+ veclen -= ulen;
+ }
+ else if (args) {
switch (intsize) {
case 'h': uv = (unsigned short)va_arg(*args, unsigned); break;
default: uv = va_arg(*args, unsigned); break;
/* This is evil, but floating point is even more evil */
+ vectorize = FALSE;
if (args)
nv = va_arg(*args, NV);
else
need = 0;
if (c != 'e' && c != 'E') {
i = PERL_INT_MIN;
- (void)frexp(nv, &i);
+ (void)Perl_frexp(nv, &i);
if (i == PERL_INT_MIN)
Perl_die(aTHX_ "panic: frexp");
if (i > 0)
*--eptr = c;
#ifdef USE_LONG_DOUBLE
{
- char* p = PERL_PRIfldbl + sizeof(PERL_PRIfldbl) - 3;
- while (p >= PERL_PRIfldbl) { *--eptr = *p--; }
+ static char const my_prifldbl[] = PERL_PRIfldbl;
+ char const *p = my_prifldbl + sizeof my_prifldbl - 3;
+ while (p >= my_prifldbl) { *--eptr = *p--; }
}
#endif
if (has_precis) {
/* SPECIAL */
case 'n':
+ vectorize = FALSE;
i = SvCUR(sv) - origlen;
if (args) {
switch (intsize) {
default:
unknown:
+ vectorize = FALSE;
if (!args && ckWARN(WARN_PRINTF) &&
(PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) {
SV *msg = sv_newmortal();
need = (have > width ? have : width);
gap = need - have;
- SvGROW(sv, SvCUR(sv) + need + 1);
+ SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
p = SvEND(sv);
if (esignlen && fill == '0') {
for (i = 0; i < esignlen; i++)
memset(p, ' ', gap);
p += gap;
}
+ if (vectorize) {
+ if (veclen) {
+ memcpy(p, dotstr, dotstrlen);
+ p += dotstrlen;
+ }
+ else
+ vectorize = FALSE; /* done iterating over vecstr */
+ }
if (is_utf)
SvUTF8_on(sv);
*p = '\0';
SvCUR(sv) = p - SvPVX(sv);
+ if (vectorize) {
+ esignlen = 0;
+ goto vector;
+ }
}
}
SV *
Perl_sv_dup(pTHX_ SV *sstr)
{
- U32 sflags;
- int dtype;
- int stype;
SV *dstr;
if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
HvRITER((HV*)dstr) = HvRITER((HV*)sstr);
if (HvARRAY((HV*)sstr)) {
- HE *entry;
STRLEN i = 0;
XPVHV *dxhv = (XPVHV*)SvANY(dstr);
XPVHV *sxhv = (XPVHV*)SvANY(sstr);
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* XXX quite arbitrary */
dptr = POPDPTR(ss,ix);
- TOPDPTR(nss,ix) = (void (*)(void*))any_dup(dptr, proto_perl);
+ TOPDPTR(nss,ix) = (void (*)(void*))any_dup((void *)dptr, proto_perl);
break;
case SAVEt_DESTRUCTOR_X:
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* XXX quite arbitrary */
dxptr = POPDXPTR(ss,ix);
- TOPDXPTR(nss,ix) = (void (*)(pTHXo_ void*))any_dup(dxptr, proto_perl);
+ TOPDXPTR(nss,ix) = (void (*)(pTHXo_ void*))any_dup((void *)dxptr, proto_perl);
break;
case SAVEt_REGCONTEXT:
case SAVEt_ALLOC:
* their pointers copied. */
IV i;
- SV *sv;
- SV **svp;
# ifdef PERL_OBJECT
CPerlObj *pPerl = new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, ipLIO,
ipD, ipS, ipP);
- PERL_SET_INTERP(pPerl);
+ PERL_SET_THX(pPerl);
# else /* !PERL_OBJECT */
PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
- PERL_SET_INTERP(my_perl);
+ PERL_SET_THX(my_perl);
# ifdef DEBUGGING
memset(my_perl, 0xab, sizeof(PerlInterpreter));
# endif /* PERL_OBJECT */
#else /* !PERL_IMPLICIT_SYS */
IV i;
- SV *sv;
- SV **svp;
PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
- PERL_SET_INTERP(my_perl);
+ PERL_SET_THX(my_perl);
# ifdef DEBUGGING
memset(my_perl, 0xab, sizeof(PerlInterpreter));
{
if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) {
if ( SvOBJECT(GvSV(sv)) ||
- GvAV(sv) && SvOBJECT(GvAV(sv)) ||
- GvHV(sv) && SvOBJECT(GvHV(sv)) ||
- GvIO(sv) && SvOBJECT(GvIO(sv)) ||
- GvCV(sv) && SvOBJECT(GvCV(sv)) )
+ (GvAV(sv) && SvOBJECT(GvAV(sv))) ||
+ (GvHV(sv) && SvOBJECT(GvHV(sv))) ||
+ (GvIO(sv) && SvOBJECT(GvIO(sv))) ||
+ (GvCV(sv) && SvOBJECT(GvCV(sv))) )
{
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));)
SvREFCNT_dec(sv);
https://perl5.git.perl.org / perl5.git / blobdiff