Skip to content

Commit

Permalink
do_print(): Use bytes_to_utf8_free_me, utf8_to_bytes_new_pv
Browse files Browse the repository at this point in the history
These new functions do the work this used to duplicate, except they
allocate memory only if necessary, instead of always, as previously
  • Loading branch information
khwilliamson committed Jan 28, 2025
1 parent 0f45bd8 commit 34e58a7
Showing 1 changed file with 12 additions and 19 deletions.
31 changes: 12 additions & 19 deletions doio.c
Original file line number Diff line number Diff line change
Expand Up @@ -2215,36 +2215,29 @@ Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
STRLEN len;
/* Do this first to trigger any overloading. */
const U8 *tmps = (const U8 *) SvPV_const(sv, len);
U8 *tmpbuf = NULL;

/* If 'tmps' doesn't need converting, this will remain NULL and
* Safefree(free_me) will do nothing; Otherwise it points to the newly
* allocated memory that tmps will also be changed to point to, so
* Safefree(free_me) will free it. This saves having to have extra
* logic. */
void *free_me = NULL;
bool happy = TRUE;

if (PerlIO_isutf8(fp)) { /* If the stream is utf8 ... */
if (!SvUTF8(sv)) { /* Convert to utf8 if necessary */
/* We don't modify the original scalar. */
tmpbuf = bytes_to_utf8(tmps, &len);
tmps = tmpbuf;
/* This doesn't modify the original scalar. */
tmps = bytes_to_utf8_free_me(tmps, &len, &free_me);
}
else if (ckWARN4_d(WARN_UTF8, WARN_SURROGATE, WARN_NON_UNICODE, WARN_NONCHAR)) {
(void) check_utf8_print(tmps, len);
}
} /* else stream isn't utf8 */
else if (DO_UTF8(sv)) { /* But if is utf8 internally, attempt to
convert to bytes */
STRLEN tmplen = len;
bool utf8 = TRUE;
U8 * const result = bytes_from_utf8(tmps, &tmplen, &utf8);
if (!utf8) {

/* Here, succeeded in downgrading from utf8. Set up to below
* output the converted value */
tmpbuf = result;
tmps = tmpbuf;
len = tmplen;
}
else { /* Non-utf8 output stream, but string only representable in
utf8 */
assert(result == tmps);
if (! utf8_to_bytes_new_pv(&tmps, &len, &free_me)) {
/* Non-utf8 output stream, but string only representable in
utf8 */
Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8),
"Wide character in %s",
PL_op ? OP_DESC(PL_op) : "print"
Expand All @@ -2262,7 +2255,7 @@ Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
* io the write failure can be delayed until the flush/close. --jhi */
if (len && (PerlIO_write(fp,tmps,len) == 0))
happy = FALSE;
Safefree(tmpbuf);
Safefree(free_me);
return happy ? !PerlIO_error(fp) : FALSE;
}
}
Expand Down

0 comments on commit 34e58a7

Please sign in to comment.