X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/cd86ed9d430a95bb9cf370c699245e1b667c146d..10517af500e340b88209d95ddbb26f6252464272:/perlio.c diff --git a/perlio.c b/perlio.c index 50966e6..ddcc357 100644 --- a/perlio.c +++ b/perlio.c @@ -614,10 +614,8 @@ PerlIO_list_free(pTHX_ PerlIO_list_t *list) if (--list->refcnt == 0) { if (list->array) { IV i; - for (i = 0; i < list->cur; i++) { - if (list->array[i].arg) - SvREFCNT_dec(list->array[i].arg); - } + for (i = 0; i < list->cur; i++) + SvREFCNT_dec(list->array[i].arg); Safefree(list->array); } Safefree(list); @@ -981,10 +979,9 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) * seen as an invalid separator character. */ const char q = ((*s == '\'') ? '"' : '\''); - if (ckWARN(WARN_LAYER)) - Perl_warner(aTHX_ packWARN(WARN_LAYER), - "Invalid separator character %c%c%c in PerlIO layer specification %s", - q, *s, q, s); + Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), + "Invalid separator character %c%c%c in PerlIO layer specification %s", + q, *s, q, s); SETERRNO(EINVAL, LIB_INVARG); return -1; } @@ -1018,10 +1015,9 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) */ case '\0': e--; - if (ckWARN(WARN_LAYER)) - Perl_warner(aTHX_ packWARN(WARN_LAYER), - "Argument list not closed for PerlIO layer \"%.*s\"", - (int) (e - s), s); + Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), + "Argument list not closed for PerlIO layer \"%.*s\"", + (int) (e - s), s); return -1; default: /* @@ -1040,13 +1036,11 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) arg = newSVpvn(as, alen); PerlIO_list_push(aTHX_ av, layer, (arg) ? arg : &PL_sv_undef); - if (arg) - SvREFCNT_dec(arg); + SvREFCNT_dec(arg); } else { - if (ckWARN(WARN_LAYER)) - Perl_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"%.*s\"", - (int) llen, s); + Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"%.*s\"", + (int) llen, s); return -1; } } @@ -1460,8 +1454,8 @@ PerlIO_layer_from_ref(pTHX_ SV *sv) PerlIO_funcs *f = PerlIO_find_layer(aTHX_ STR_WITH_LEN("scalar"), 1); /* This isn't supposed to happen, since PerlIO::scalar is core, * but could happen anyway in smaller installs or with PAR */ - if (!f && ckWARN(WARN_LAYER)) - Perl_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"scalar\""); + if (!f) + Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"scalar\""); return f; } @@ -1566,8 +1560,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, arg = (*l->tab->Getarg) (aTHX_ &l, NULL, 0); PerlIO_list_push(aTHX_ layera, l->tab, (arg) ? arg : &PL_sv_undef); - if (arg) - SvREFCNT_dec(arg); + SvREFCNT_dec(arg); l = *PerlIONext(&l); } } @@ -2272,8 +2265,7 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg); if (PerlIOBase(o)->flags & PERLIO_F_UTF8) PerlIOBase(f)->flags |= PERLIO_F_UTF8; - if (arg) - SvREFCNT_dec(arg); + SvREFCNT_dec(arg); } return f; } @@ -5165,16 +5157,18 @@ PerlIO_tmpfile(void) int fd = -1; char tempname[] = "/tmp/PerlIO_XXXXXX"; const char * const tmpdir = PL_tainting ? NULL : PerlEnv_getenv("TMPDIR"); - SV * const sv = tmpdir && *tmpdir ? newSVpv(tmpdir, 0) : NULL; + SV * sv; /* * I have no idea how portable mkstemp() is ... NI-S */ - if (sv) { + if (tmpdir && *tmpdir) { /* if TMPDIR is set and not empty, we try that first */ + sv = newSVpv(tmpdir, 0); sv_catpv(sv, tempname + 4); fd = mkstemp(SvPVX(sv)); } if (fd < 0) { + sv = NULL; /* else we try /tmp */ fd = mkstemp(tempname); } @@ -5184,8 +5178,7 @@ PerlIO_tmpfile(void) PerlIOBase(f)->flags |= PERLIO_F_TEMP; PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname); } - if (sv) - SvREFCNT_dec(sv); + SvREFCNT_dec(sv); # else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */ FILE * const stdio = PerlSIO_tmpfile();