@@ -2215,36 +2215,29 @@ Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
2215
2215
STRLEN len ;
2216
2216
/* Do this first to trigger any overloading. */
2217
2217
const U8 * tmps = (const U8 * ) SvPV_const (sv , len );
2218
- U8 * tmpbuf = NULL ;
2219
2218
2219
+ /* If 'tmps' doesn't need converting, this will remain NULL and
2220
+ * Safefree(free_me) will do nothing; Otherwise it points to the newly
2221
+ * allocated memory that tmps will also be changed to point to, so
2222
+ * Safefree(free_me) will free it. This saves having to have extra
2223
+ * logic. */
2224
+ void * free_me = NULL ;
2220
2225
bool happy = TRUE;
2221
2226
2222
2227
if (PerlIO_isutf8 (fp )) { /* If the stream is utf8 ... */
2223
2228
if (!SvUTF8 (sv )) { /* Convert to utf8 if necessary */
2224
- /* We don't modify the original scalar. */
2225
- tmpbuf = bytes_to_utf8 (tmps , & len );
2226
- tmps = tmpbuf ;
2229
+ /* This doesn't modify the original scalar. */
2230
+ tmps = bytes_to_utf8_free_me (tmps , & len , & free_me );
2227
2231
}
2228
2232
else if (ckWARN4_d (WARN_UTF8 , WARN_SURROGATE , WARN_NON_UNICODE , WARN_NONCHAR )) {
2229
2233
(void ) check_utf8_print (tmps , len );
2230
2234
}
2231
2235
} /* else stream isn't utf8 */
2232
2236
else if (DO_UTF8 (sv )) { /* But if is utf8 internally, attempt to
2233
2237
convert to bytes */
2234
- STRLEN tmplen = len ;
2235
- bool utf8 = TRUE;
2236
- U8 * const result = bytes_from_utf8 (tmps , & tmplen , & utf8 );
2237
- if (!utf8 ) {
2238
-
2239
- /* Here, succeeded in downgrading from utf8. Set up to below
2240
- * output the converted value */
2241
- tmpbuf = result ;
2242
- tmps = tmpbuf ;
2243
- len = tmplen ;
2244
- }
2245
- else { /* Non-utf8 output stream, but string only representable in
2246
- utf8 */
2247
- assert (result == tmps );
2238
+ if (! utf8_to_bytes_new_pv (& tmps , & len , & free_me )) {
2239
+ /* Non-utf8 output stream, but string only representable in
2240
+ utf8 */
2248
2241
Perl_ck_warner_d (aTHX_ packWARN (WARN_UTF8 ),
2249
2242
"Wide character in %s" ,
2250
2243
PL_op ? OP_DESC (PL_op ) : "print"
@@ -2262,7 +2255,7 @@ Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
2262
2255
* io the write failure can be delayed until the flush/close. --jhi */
2263
2256
if (len && (PerlIO_write (fp ,tmps ,len ) == 0 ))
2264
2257
happy = FALSE;
2265
- Safefree (tmpbuf );
2258
+ Safefree (free_me );
2266
2259
return happy ? !PerlIO_error (fp ) : FALSE;
2267
2260
}
2268
2261
}
0 commit comments