#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+#include "ppport.h"
-static I32 num_q (char *s, STRLEN slen);
-static I32 esc_q (char *dest, char *src, STRLEN slen);
-static I32 esc_q_utf8 (pTHX_ SV *sv, char *src, STRLEN slen);
+#if PERL_VERSION < 6
+# define DD_USE_OLD_ID_FORMAT
+#endif
+
+static I32 num_q (const char *s, STRLEN slen);
+static I32 esc_q (char *dest, const char *src, STRLEN slen);
+static I32 esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen);
+static I32 needs_quote(register const char *s);
static SV *sv_x (pTHX_ SV *sv, const char *str, STRLEN len, I32 n);
static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval,
HV *seenhv, AV *postav, I32 *levelp, I32 indent,
UV
Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen)
{
- UV uv = utf8_to_uv(s, UTF8_MAXLEN, retlen,
+ const UV uv = utf8_to_uv(s, UTF8_MAXLEN, retlen,
ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
return UNI_TO_NATIVE(uv);
}
/* does a string need to be protected? */
static I32
-needs_quote(register char *s)
+needs_quote(register const char *s)
{
TOP:
if (s[0] == ':') {
/* count the number of "'"s and "\"s in string */
static I32
-num_q(register char *s, register STRLEN slen)
+num_q(register const char *s, register STRLEN slen)
{
register I32 ret = 0;
/* slen number of characters in s will be escaped */
/* destination must be long enough for additional chars */
static I32
-esc_q(register char *d, register char *s, register STRLEN slen)
+esc_q(register char *d, register const char *s, register STRLEN slen)
{
register I32 ret = 0;
}
static I32
-esc_q_utf8(pTHX_ SV* sv, register char *src, register STRLEN slen)
+esc_q_utf8(pTHX_ SV* sv, register const char *src, register STRLEN slen)
{
- char *s, *send, *r, *rstart;
+ char *r, *rstart;
+ const char *s = src;
+ const char * const send = src + slen;
STRLEN j, cur = SvCUR(sv);
/* Could count 128-255 and 256+ in two variables, if we want to
be like &qquote and make a distinction. */
STRLEN normal = 0;
/* this will need EBCDICification */
- for (s = src, send = src + slen; s < send; s += UTF8SKIP(s)) {
- UV k = utf8_to_uvchr((U8*)s, NULL);
+ for (s = src; s < send; s += UTF8SKIP(s)) {
+ const UV k = utf8_to_uvchr((U8*)s, NULL);
- if (k > 127) {
+#ifdef EBCDIC
+ if (!isprint(k) || k > 256) {
+#else
+ if (k > 127) {
+#endif
/* 4: \x{} then count the number of hex digits. */
grow += 4 + (k <= 0xFF ? 2 : k <= 0xFFF ? 3 : k <= 0xFFFF ? 4 :
#if UVSIZE == 4
*r++ = '"';
for (s = src; s < send; s += UTF8SKIP(s)) {
- UV k = utf8_to_uvchr((U8*)s, NULL);
+ const UV k = utf8_to_uvchr((U8*)s, NULL);
if (k == '"' || k == '\\' || k == '$' || k == '@') {
*r++ = '\\';
*r++ = (char)k;
}
- else if (k < 0x80)
+ else
+#ifdef EBCDIC
+ if (isprint(k) && k < 256)
+#else
+ if (k < 0x80)
+#endif
*r++ = (char)k;
else {
- /* The return value of sprintf() is unportable.
- * In modern systems it returns (int) the number of characters,
- * but in older systems it might return (char*) the original
- * buffer, or it might even be (void). The easiest portable
- * thing to do is probably use sprintf() in void context and
- * then strlen(buffer) for the length. The more proper way
- * would of course be to figure out the prototype of sprintf.
- * --jhi */
- sprintf(r, "\\x{%"UVxf"}", k);
- r += strlen(r);
+ r = r + my_sprintf(r, "\\x{%"UVxf"}", k);
}
}
*r++ = '"';
rstart = r = SvPVX(sv) + cur;
*r++ = '\'';
for (s = src; s < send; s ++) {
- char k = *s;
+ const char k = *s;
if (k == '\'' || k == '\\')
*r++ = '\\';
*r++ = k;
static SV *
sv_x(pTHX_ SV *sv, const char *str, STRLEN len, I32 n)
{
- if (sv == Nullsv)
+ if (!sv)
sv = newSVpvn("", 0);
+#ifdef DEBUGGING
else
assert(SvTYPE(sv) >= SVt_PV);
+#endif
if (n > 0) {
SvGROW(sv, len*n + SvCUR(sv) + 1);
if (len == 1) {
- char *start = SvPVX(sv) + SvCUR(sv);
+ char * const start = SvPVX(sv) + SvCUR(sv);
SvCUR_set(sv, SvCUR(sv) + n);
start[n] = '\0';
while (n > 0)
{
char tmpbuf[128];
U32 i;
- char *c, *r, *realpack, id[128];
+ char *c, *r, *realpack;
+#ifdef DD_USE_OLD_ID_FORMAT
+ char id[128];
+#else
+ UV id_buffer;
+ char *const id = (char *)&id_buffer;
+#endif
SV **svp;
SV *sv, *ipad, *ival;
SV *blesspad = Nullsv;
- AV *seenentry = Nullav;
+ AV *seenentry = NULL;
char *iname;
STRLEN inamelen, idlen = 0;
U32 realtype;
if (!val)
return 0;
+ /* If the ouput buffer has less than some arbitary amount of space
+ remaining, then enlarge it. For the test case (25M of output),
+ *1.1 was slower, *2.0 was the same, so the first guess of 1.5 is
+ deemed to be good enough. */
+ if (SvTYPE(retval) >= SVt_PV && (SvLEN(retval) - SvCUR(retval)) < 42) {
+ sv_grow(retval, SvCUR(retval) * 3 / 2);
+ }
+
realtype = SvTYPE(val);
if (SvGMAGICAL(val))
ival = SvRV(val);
realtype = SvTYPE(ival);
- (void) sprintf(id, "0x%"UVxf, PTR2UV(ival));
- idlen = strlen(id);
+#ifdef DD_USE_OLD_ID_FORMAT
+ idlen = my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(ival));
+#else
+ id_buffer = PTR2UV(ival);
+ idlen = sizeof(id_buffer);
+#endif
if (SvOBJECT(ival))
realpack = HvNAME_get(SvSTASH(ival));
else
return 1;
}
else {
+#ifdef DD_USE_OLD_ID_FORMAT
warn("ref name not found for %s", id);
+#else
+ warn("ref name not found for 0x%"UVxf, PTR2UV(ival));
+#endif
return 0;
}
}
av_push(seenentry, namesv);
(void)SvREFCNT_inc(val);
av_push(seenentry, val);
- (void)hv_store(seenhv, id, strlen(id),
+ (void)hv_store(seenhv, id, idlen,
newRV_inc((SV*)seenentry), 0);
SvREFCNT_dec(seenentry);
}
if (realpack && *realpack == 'R' && strEQ(realpack, "Regexp")) {
STRLEN rlen;
- char *rval = SvPV(val, rlen);
- char *slash = strchr(rval, '/');
+ const char *rval = SvPV(val, rlen);
+ const char *slash = strchr(rval, '/');
sv_catpvn(retval, "qr/", 3);
while (slash) {
sv_catpvn(retval, rval, slash-rval);
*/
if (!purity && maxdepth > 0 && *levelp >= maxdepth) {
STRLEN vallen;
- char *valstr = SvPV(val,vallen);
+ const char * const valstr = SvPV(val,vallen);
sv_catpvn(retval, "'", 1);
sv_catpvn(retval, valstr, vallen);
sv_catpvn(retval, "'", 1);
if (realpack) { /* we have a blessed ref */
STRLEN blesslen;
- char *blessstr = SvPV(bless, blesslen);
+ const char * const blessstr = SvPV(bless, blesslen);
sv_catpvn(retval, blessstr, blesslen);
sv_catpvn(retval, "( ", 2);
if (indent >= 2) {
(*levelp)++;
ipad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), *levelp);
- if (realtype <= SVt_PVBM) { /* scalar ref */
- SV *namesv = newSVpvn("${", 2);
+ if (
+#if PERL_VERSION < 9
+ realtype <= SVt_PVBM
+#else
+ realtype <= SVt_PVMG
+#endif
+ ) { /* scalar ref */
+ SV * const namesv = newSVpvn("${", 2);
sv_catpvn(namesv, name, namelen);
sv_catpvn(namesv, "}", 1);
if (realpack) { /* blessed */
SvREFCNT_dec(namesv);
}
else if (realtype == SVt_PVGV) { /* glob ref */
- SV *namesv = newSVpvn("*{", 2);
+ SV * const namesv = newSVpvn("*{", 2);
sv_catpvn(namesv, name, namelen);
sv_catpvn(namesv, "}", 1);
sv_catpvn(retval, "\\", 1);
else if (realtype == SVt_PVAV) {
SV *totpad;
I32 ix = 0;
- I32 ixmax = av_len((AV *)ival);
+ const I32 ixmax = av_len((AV *)ival);
- SV *ixsv = newSViv(0);
+ SV * const ixsv = newSViv(0);
/* allowing for a 24 char wide array index */
New(0, iname, namelen+28, char);
(void)strcpy(iname, name);
ilen = inamelen;
sv_setiv(ixsv, ix);
- (void) sprintf(iname+ilen, "%"IVdf, (IV)ix);
- ilen = strlen(iname);
+ ilen = ilen + my_sprintf(iname+ilen, "%"IVdf, (IV)ix);
iname[ilen++] = ']'; iname[ilen] = '\0';
if (indent >= 3) {
sv_catsv(retval, totpad);
sv_catpvn(retval, ",", 1);
}
if (ixmax >= 0) {
- SV *opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), (*levelp)-1);
+ SV * const opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), (*levelp)-1);
sv_catsv(retval, totpad);
sv_catsv(retval, opad);
SvREFCNT_dec(opad);
}
else if (realtype == SVt_PVHV) {
SV *totpad, *newapad;
- SV *iname, *sname;
+ SV *sname;
HE *entry;
char *key;
I32 klen;
SV *hval;
- AV *keys = Nullav;
+ AV *keys = NULL;
- iname = newSVpvn(name, namelen);
+ SV * const iname = newSVpvn(name, namelen);
if (name[0] == '%') {
sv_catpvn(retval, "(", 1);
(SvPVX(iname))[0] = '$';
I32 nlen;
bool do_utf8 = FALSE;
- if ((sortkeys && !(keys && (I32)i <= av_len(keys))) ||
- !(entry = hv_iternext((HV *)ival)))
- break;
+ if (sortkeys) {
+ if (!(keys && (I32)i <= av_len(keys))) break;
+ } else {
+ if (!(entry = hv_iternext((HV *)ival))) break;
+ }
if (i)
sv_catpvn(retval, ",", 1);
hval = hv_iterval((HV*)ival, entry);
}
- do_utf8 = DO_UTF8(keysv);
key = SvPV(keysv, keylen);
+ do_utf8 = DO_UTF8(keysv);
klen = keylen;
sv_catsv(retval, totpad);
STRLEN i;
if (namelen) {
- (void) sprintf(id, "0x%"UVxf, PTR2UV(val));
- if ((svp = hv_fetch(seenhv, id, (idlen = strlen(id)), FALSE)) &&
+#ifdef DD_USE_OLD_ID_FORMAT
+ idlen = my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(val));
+#else
+ id_buffer = PTR2UV(val);
+ idlen = sizeof(id_buffer);
+#endif
+ if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) &&
(sv = *svp) && SvROK(sv) &&
(seenentry = (AV*)SvRV(sv)))
{
}
}
else if (val != &PL_sv_undef) {
- SV *namesv;
- namesv = newSVpvn("\\", 1);
+ SV * const namesv = newSVpvn("\\", 1);
sv_catpvn(namesv, name, namelen);
seenentry = newAV();
av_push(seenentry, namesv);
av_push(seenentry, newRV_inc(val));
- (void)hv_store(seenhv, id, strlen(id), newRV_inc((SV*)seenentry), 0);
+ (void)hv_store(seenhv, id, idlen, newRV_inc((SV*)seenentry), 0);
SvREFCNT_dec(seenentry);
}
}
if (DD_is_integer(val)) {
STRLEN len;
if (SvIsUV(val))
- (void) sprintf(tmpbuf, "%"UVuf, SvUV(val));
+ len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"UVuf, SvUV(val));
else
- (void) sprintf(tmpbuf, "%"IVdf, SvIV(val));
- len = strlen(tmpbuf);
+ len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"IVdf, SvIV(val));
if (SvPOK(val)) {
/* Need to check to see if this is a string such as " 0".
I'm assuming from sprintf isn't going to clash with utf8.
Is this valid on EBCDIC? */
STRLEN pvlen;
- const char *pv = SvPV(val, pvlen);
+ const char * const pv = SvPV(val, pvlen);
if (pvlen != len || memNE(pv, tmpbuf, len))
goto integer_came_from_string;
}
static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
static const STRLEN sizes[] = { 8, 7, 6 };
SV *e;
- SV *nname = newSVpvn("", 0);
- SV *newapad = newSVpvn("", 0);
- GV *gv = (GV*)val;
+ SV * const nname = newSVpvn("", 0);
+ SV * const newapad = newSVpvn("", 0);
+ GV * const gv = (GV*)val;
I32 j;
for (j=0; j<3; j++) {
{
HV *hv;
SV *retval, *valstr;
- HV *seenhv = Nullhv;
+ HV *seenhv = NULL;
AV *postav, *todumpav, *namesav;
I32 level = 0;
I32 indent, terse, i, imax, postlen;
(void)sv_2mortal(href);
}
- todumpav = namesav = Nullav;
- seenhv = Nullhv;
+ todumpav = namesav = NULL;
+ seenhv = NULL;
val = pad = xpad = apad = sep = pair = varname
- = freezer = toaster = bless = &PL_sv_undef;
+ = freezer = toaster = bless = sortkeys = &PL_sv_undef;
name = sv_newmortal();
indent = 2;
terse = purity = deepcopy = 0;
val = *svp;
else
val = &PL_sv_undef;
- if ((svp = av_fetch(namesav, i, TRUE)))
+ if ((svp = av_fetch(namesav, i, TRUE))) {
sv_setsv(name, *svp);
+ if (SvOK(*svp) && !SvPOK(*svp))
+ (void)SvPV_nolen_const(name);
+ }
else
(void)SvOK_off(name);
- if (SvOK(name)) {
+ if (SvPOK(name)) {
if ((SvPVX_const(name))[0] == '*') {
if (SvROK(val)) {
switch (SvTYPE(SvRV(val))) {
sv_insert(name, 0, 0, "$", 1);
}
else {
- STRLEN nchars = 0;
+ STRLEN nchars;
sv_setpvn(name, "$", 1);
sv_catsv(name, varname);
- (void) sprintf(tmpbuf, "%"IVdf, (IV)(i+1));
- nchars = strlen(tmpbuf);
+ nchars = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"IVdf, (IV)(i+1));
sv_catpvn(name, tmpbuf, nchars);
}
if (indent >= 2) {
- SV *tmpsv = sv_x(aTHX_ Nullsv, " ", 1, SvCUR(name)+3);
+ SV * const tmpsv = sv_x(aTHX_ NULL, " ", 1, SvCUR(name)+3);
newapad = newSVsv(apad);
sv_catsv(newapad, tmpsv);
SvREFCNT_dec(tmpsv);
projects / p5sagit/p5-mst-13.2.git / blobdiff