#include "XSUB.h"
#ifndef PERL_VERSION
-#include "patchlevel.h"
-#define PERL_VERSION PATCHLEVEL
+# include <patchlevel.h>
+# ifndef PERL_VERSION
+# include <could_not_find_Perl_patchlevel.h>
+# endif
+# define PERL_VERSION PATCHLEVEL
#endif
#if PERL_VERSION < 5
else if (k < 0x80)
*r++ = (char)k;
else {
- r += sprintf(r, "\\x{%"UVxf"}", k);
+ /* 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++ = '"';
i = perl_call_method(SvPVX(freezer), G_EVAL|G_SCALAR);
SPAGAIN;
if (SvTRUE(ERRSV))
- warn("WARNING(Freezer method call failed): %s",
- SvPVX(ERRSV));
+ warn("WARNING(Freezer method call failed): %"SVf"", ERRSV);
else if (i)
val = newSVsv(POPs);
PUTBACK; FREETMPS; LEAVE;
/* foreach (keys %hash) */
for (i = 0; 1; i++) {
- char *nkey = NULL;
+ char *nkey;
+ char *nkey_buffer = NULL;
I32 nticks = 0;
SV* keysv;
STRLEN keylen;
+ I32 nlen;
bool do_utf8 = FALSE;
if ((sortkeys && !(keys && (I32)i <= av_len(keys))) ||
svp = av_fetch(keys, i, FALSE);
keysv = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
key = SvPV(keysv, keylen);
- svp = hv_fetch((HV*)ival, key, keylen, 0);
+ svp = hv_fetch((HV*)ival, key,
+ SvUTF8(keysv) ? -(I32)keylen : keylen, 0);
hval = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
}
else {
key = SvPV(keysv, keylen);
klen = keylen;
- if (do_utf8) {
- char *okey = SvPVX(retval) + SvCUR(retval);
- I32 nlen;
+ sv_catsv(retval, totpad);
+ sv_catsv(retval, ipad);
+ /* old logic was first to check utf8 flag, and if utf8 always
+ call esc_q_utf8. This caused test to break under -Mutf8,
+ because there even strings like 'c' have utf8 flag on.
+ Hence with quotekeys == 0 the XS code would still '' quote
+ them based on flags, whereas the perl code would not,
+ based on regexps.
+ The perl code is correct.
+ needs_quote() decides that anything that isn't a valid
+ perl identifier needs to be quoted, hence only correctly
+ formed strings with no characters outside [A-Za-z0-9_:]
+ won't need quoting. None of those characters are used in
+ the byte encoding of utf8, so anything with utf8
+ encoded characters in will need quoting. Hence strings
+ with utf8 encoded characters in will end up inside do_utf8
+ just like before, but now strings with utf8 flag set but
+ only ascii characters will end up in the unquoted section.
- sv_catsv(retval, totpad);
- sv_catsv(retval, ipad);
- nlen = esc_q_utf8(aTHX_ retval, key, klen);
-
- sname = newSVsv(iname);
- sv_catpvn(sname, okey, nlen);
- sv_catpvn(sname, "}", 1);
- }
- else {
- if (quotekeys || needs_quote(key)) {
+ There should also be less tests for the (probably currently)
+ more common doesn't need quoting case.
+ The code is also smaller (22044 vs 22260) because I've been
+ able to pull the comon logic out to both sides. */
+ if (quotekeys || needs_quote(key)) {
+ if (do_utf8) {
+ STRLEN ocur = SvCUR(retval);
+ nlen = esc_q_utf8(aTHX_ retval, key, klen);
+ nkey = SvPVX(retval) + ocur;
+ }
+ else {
nticks = num_q(key, klen);
- New(0, nkey, klen+nticks+3, char);
+ New(0, nkey_buffer, klen+nticks+3, char);
+ nkey = nkey_buffer;
nkey[0] = '\'';
if (nticks)
klen += esc_q(nkey+1, key, klen);
(void)Copy(key, nkey+1, klen, char);
nkey[++klen] = '\'';
nkey[++klen] = '\0';
+ nlen = klen;
+ sv_catpvn(retval, nkey, klen);
}
- else {
- New(0, nkey, klen, char);
- (void)Copy(key, nkey, klen, char);
- }
-
- sname = newSVsv(iname);
- sv_catpvn(sname, nkey, klen);
- sv_catpvn(sname, "}", 1);
-
- sv_catsv(retval, totpad);
- sv_catsv(retval, ipad);
- sv_catpvn(retval, nkey, klen);
+ }
+ else {
+ nkey = key;
+ nlen = klen;
+ sv_catpvn(retval, nkey, klen);
}
+ sname = newSVsv(iname);
+ sv_catpvn(sname, nkey, nlen);
+ sv_catpvn(sname, "}", 1);
+
sv_catpvn(retval, " => ", 4);
if (indent >= 2) {
char *extra;
freezer, toaster, purity, deepcopy, quotekeys, bless,
maxdepth, sortkeys);
SvREFCNT_dec(sname);
- Safefree(nkey);
+ Safefree(nkey_buffer);
if (indent >= 2)
SvREFCNT_dec(newapad);
}
projects / p5sagit/p5-mst-13.2.git / blobdiff