X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=fd40ae08fcf490d48cb2015beb009053a6721d2e;hb=a403baf6db062a9762514a55376b87d7258108a5;hp=94e3826660358f3ca4bdf579322f151e3c28c70e;hpb=1141d9f89ca1cb89e46951e8afc784c7b4862cd2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index 94e3826..fd40ae0 100644 --- a/doio.c +++ b/doio.c @@ -210,8 +210,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, *tend-- = '\0'; if (num_svs) { /* New style explict name, type is just mode and discipline/layer info */ - STRLEN l; - name = SvPV(*svp, l) ; + STRLEN l = 0; + name = SvOK(*svp) ? SvPV(*svp, l) : ""; len = (I32)l; name = savepvn(name, len); SAVEFREEPV(name); @@ -504,15 +504,19 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (ckWARN(WARN_IO)) { if ((IoTYPE(io) == IoTYPE_RDONLY) && (fp == PerlIO_stdout() || fp == PerlIO_stderr())) { - Perl_warner(aTHX_ WARN_IO, "'std%s' opened only for input", - (fp == PerlIO_stdout()) ? "out" : "err"); + Perl_warner(aTHX_ WARN_IO, + "Filehandle STD%s opened only for input", + (fp == PerlIO_stdout()) ? "OUT" : "ERR"); } else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) { - Perl_warner(aTHX_ WARN_IO, "'stdin' opened only for output"); + Perl_warner(aTHX_ WARN_IO, + "Filehandle STDIN opened only for output"); } } - if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) { + if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && + /* FIXME: This next term is a hack to avoid fileno on PerlIO::Scalar */ + !(num_svs && SvROK(*svp))) { if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) { (void)PerlIO_close(fp); goto say_false; @@ -553,13 +557,16 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (savefd != fd) { Pid_t pid; SV *sv; - PerlLIO_dup2(fd, savefd); + if (PerlLIO_dup2(fd, savefd) < 0) { + (void)PerlIO_close(fp); + goto say_false; + } #ifdef VMS if (savefd != PerlIO_fileno(PerlIO_stdin())) { char newname[FILENAME_MAX+1]; if (fgetname(fp, newname)) { - if (savefd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm("SYS$OUTPUT", newname); - if (savefd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm("SYS$ERROR", newname); + if (fd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm(aTHX_ "SYS$OUTPUT", newname); + if (fd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm(aTHX_ "SYS$ERROR", newname); } } #endif @@ -1202,8 +1209,11 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) if (!SvUTF8(sv)) sv_utf8_upgrade(sv = sv_mortalcopy(sv)); } - else if (DO_UTF8(sv)) - sv_utf8_downgrade((sv = sv_mortalcopy(sv)), FALSE); + else if (DO_UTF8(sv)) { + if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)) { + Perl_warner(aTHX_ WARN_UTF8, "Wide character in print"); + } + } tmps = SvPV(sv, len); break; }