This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
update PERL_MEM_LOG in perlhack.pod
[perl5.git]
/
perlio.c
diff --git
a/perlio.c
b/perlio.c
index
e2d64d4
..
4fe4fa7
100644
(file)
--- a/
perlio.c
+++ b/
perlio.c
@@
-10,6
+10,8
@@
/*
* Hour after hour for nearly three weary days he had jogged up and down,
* over passes, and through long dales, and across many streams.
/*
* Hour after hour for nearly three weary days he had jogged up and down,
* over passes, and through long dales, and across many streams.
+ *
+ * [pp.791-792 of _The Lord of the Rings_, V/iii: "The Muster of Rohan"]
*/
/* This file contains the functions needed to implement PerlIO, which
*/
/* This file contains the functions needed to implement PerlIO, which
@@
-805,7
+807,7
@@
PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
} else {
SV * const pkgsv = newSVpvs("PerlIO");
SV * const layer = newSVpvn(name, len);
} else {
SV * const pkgsv = newSVpvs("PerlIO");
SV * const layer = newSVpvn(name, len);
- CV * const cv =
Perl_get_cvn_flags(aTHX_ STR_WITH_LEN("PerlIO::Layer::NoWarnings")
, 0);
+ CV * const cv =
get_cvs("PerlIO::Layer::NoWarnings"
, 0);
ENTER;
SAVEINT(PL_in_load_module);
if (cv) {
ENTER;
SAVEINT(PL_in_load_module);
if (cv) {
@@
-832,7
+834,7
@@
static int
perlio_mg_set(pTHX_ SV *sv, MAGIC *mg)
{
if (SvROK(sv)) {
perlio_mg_set(pTHX_ SV *sv, MAGIC *mg)
{
if (SvROK(sv)) {
- IO * const io = GvIOn(
(GV *) SvRV(sv
));
+ IO * const io = GvIOn(
MUTABLE_GV(SvRV(sv)
));
PerlIO * const ifp = IoIFP(io);
PerlIO * const ofp = IoOFP(io);
Perl_warn(aTHX_ "set %" SVf " %p %p %p",
PerlIO * const ifp = IoIFP(io);
PerlIO * const ofp = IoOFP(io);
Perl_warn(aTHX_ "set %" SVf " %p %p %p",
@@
-845,7
+847,7
@@
static int
perlio_mg_get(pTHX_ SV *sv, MAGIC *mg)
{
if (SvROK(sv)) {
perlio_mg_get(pTHX_ SV *sv, MAGIC *mg)
{
if (SvROK(sv)) {
- IO * const io = GvIOn(
(GV *) SvRV(sv
));
+ IO * const io = GvIOn(
MUTABLE_GV(SvRV(sv)
));
PerlIO * const ifp = IoIFP(io);
PerlIO * const ofp = IoOFP(io);
Perl_warn(aTHX_ "get %" SVf " %p %p %p",
PerlIO * const ifp = IoIFP(io);
PerlIO * const ofp = IoOFP(io);
Perl_warn(aTHX_ "get %" SVf " %p %p %p",
@@
-1771,10
+1773,7
@@
PerlIO_has_base(PerlIO *f)
if (tab)
return (tab->Get_base != NULL);
if (tab)
return (tab->Get_base != NULL);
- SETERRNO(EINVAL, LIB_INVARG);
}
}
- else
- SETERRNO(EBADF, SS_IVCHAN);
return 0;
}
return 0;
}
@@
-1782,15
+1781,14
@@
PerlIO_has_base(PerlIO *f)
int
PerlIO_fast_gets(PerlIO *f)
{
int
PerlIO_fast_gets(PerlIO *f)
{
- if (PerlIOValid(f) && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) {
- const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
+ if (PerlIOValid(f)) {
+ if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS) {
+ const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
- if (tab)
- return (tab->Set_ptrcnt != NULL);
- SETERRNO(EINVAL, LIB_INVARG);
+
if (tab)
+
return (tab->Set_ptrcnt != NULL);
+ }
}
}
- else
- SETERRNO(EBADF, SS_IVCHAN);
return 0;
}
return 0;
}
@@
-1803,10
+1801,7
@@
PerlIO_has_cntptr(PerlIO *f)
if (tab)
return (tab->Get_ptr != NULL && tab->Get_cnt != NULL);
if (tab)
return (tab->Get_ptr != NULL && tab->Get_cnt != NULL);
- SETERRNO(EINVAL, LIB_INVARG);
}
}
- else
- SETERRNO(EBADF, SS_IVCHAN);
return 0;
}
return 0;
}
@@
-1819,10
+1814,7
@@
PerlIO_canset_cnt(PerlIO *f)
if (tab)
return (tab->Set_ptrcnt != NULL);
if (tab)
return (tab->Set_ptrcnt != NULL);
- SETERRNO(EINVAL, LIB_INVARG);
}
}
- else
- SETERRNO(EBADF, SS_IVCHAN);
return 0;
}
return 0;
}
@@
-3031,7
+3023,9
@@
PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o,mode));
set_this:
PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o,mode));
set_this:
PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
- PerlIOUnix_refcnt_inc(fileno(stdio));
+ if(stdio) {
+ PerlIOUnix_refcnt_inc(fileno(stdio));
+ }
}
return f;
}
}
return f;
}
@@
-3129,8
+3123,8
@@
PerlIOStdio_close(pTHX_ PerlIO *f)
const int fd = fileno(stdio);
int invalidate = 0;
IV result = 0;
const int fd = fileno(stdio);
int invalidate = 0;
IV result = 0;
- int saveerr = 0;
int dupfd = -1;
int dupfd = -1;
+ dSAVEDERRNO;
#ifdef USE_ITHREADS
dVAR;
#endif
#ifdef USE_ITHREADS
dVAR;
#endif
@@
-3164,7
+3158,7
@@
PerlIOStdio_close(pTHX_ PerlIO *f)
fileno slot of the FILE *
*/
result = PerlIO_flush(f);
fileno slot of the FILE *
*/
result = PerlIO_flush(f);
-
saveerr = errno
;
+
SAVE_ERRNO
;
invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio);
if (!invalidate) {
#ifdef USE_ITHREADS
invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio);
if (!invalidate) {
#ifdef USE_ITHREADS
@@
-3197,13
+3191,15
@@
PerlIOStdio_close(pTHX_ PerlIO *f)
}
#endif
}
}
#endif
}
+ } else {
+ SAVE_ERRNO; /* This is here only to silence compiler warnings */
}
result = PerlSIO_fclose(stdio);
/* We treat error from stdio as success if we invalidated
errno may NOT be expected EBADF
*/
if (invalidate && result != 0) {
}
result = PerlSIO_fclose(stdio);
/* We treat error from stdio as success if we invalidated
errno may NOT be expected EBADF
*/
if (invalidate && result != 0) {
-
errno = saveerr
;
+
RESTORE_ERRNO
;
result = 0;
}
#ifdef SOCKS5_VERSION_NAME
result = 0;
}
#ifdef SOCKS5_VERSION_NAME
@@
-3365,9
+3361,9
@@
PerlIOStdio_flush(pTHX_ PerlIO *f)
/*
* Not writeable - sync by attempting a seek
*/
/*
* Not writeable - sync by attempting a seek
*/
-
const int err = errno
;
+
dSAVE_ERRNO
;
if (PerlSIO_fseek(stdio, (Off_t) 0, SEEK_CUR) != 0)
if (PerlSIO_fseek(stdio, (Off_t) 0, SEEK_CUR) != 0)
-
errno = err
;
+
RESTORE_ERRNO
;
#endif
}
return 0;
#endif
}
return 0;
@@
-4638,9
+4634,7
@@
PerlIOCrlf_binmode(pTHX_ PerlIO *f)
PerlIOBase(f)->flags &= ~PERLIO_F_CRLF;
#ifndef PERLIO_USING_CRLF
/* CRLF is unusual case - if this is just the :crlf layer pop it */
PerlIOBase(f)->flags &= ~PERLIO_F_CRLF;
#ifndef PERLIO_USING_CRLF
/* CRLF is unusual case - if this is just the :crlf layer pop it */
- if (PerlIOBase(f)->tab == &PerlIO_crlf) {
- PerlIO_pop(aTHX_ f);
- }
+ PerlIO_pop(aTHX_ f);
#endif
}
return 0;
#endif
}
return 0;
@@
-5168,18
+5162,30
@@
PerlIO_tmpfile(void)
f = PerlIO_fdopen(fd, "w+b");
#else /* WIN32 */
# if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
f = PerlIO_fdopen(fd, "w+b");
#else /* WIN32 */
# if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
- SV * const sv = newSVpvs("/tmp/PerlIO_XXXXXX");
+ 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;
/*
* I have no idea how portable mkstemp() is ... NI-S
*/
/*
* I have no idea how portable mkstemp() is ... NI-S
*/
- const int fd = mkstemp(SvPVX(sv));
+ if (sv) {
+ /* if TMPDIR is set and not empty, we try that first */
+ sv_catpv(sv, tempname + 4);
+ fd = mkstemp(SvPVX(sv));
+ }
+ if (fd < 0) {
+ /* else we try /tmp */
+ fd = mkstemp(tempname);
+ }
if (fd >= 0) {
f = PerlIO_fdopen(fd, "w+");
if (f)
PerlIOBase(f)->flags |= PERLIO_F_TEMP;
if (fd >= 0) {
f = PerlIO_fdopen(fd, "w+");
if (f)
PerlIOBase(f)->flags |= PERLIO_F_TEMP;
- PerlLIO_unlink(
SvPVX_const(sv)
);
+ PerlLIO_unlink(
sv ? SvPVX_const(sv) : tempname
);
}
}
- SvREFCNT_dec(sv);
+ if (sv)
+ SvREFCNT_dec(sv);
# else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
FILE * const stdio = PerlSIO_tmpfile();
# else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
FILE * const stdio = PerlSIO_tmpfile();