(*tab->callback) args; \
else \
PerlIOBase_ ## base args; \
-- SETERRNO(EINVAL, LIB_INVARG); \
} \
else \
SETERRNO(EBADF, SS_IVCHAN)
PerlIO_funcs *tab = PerlIOBase(f)->tab; \
if (tab && tab->callback) \
(*tab->callback) args; \
-- SETERRNO(EINVAL, LIB_INVARG); \
++ else \
++ SETERRNO(EINVAL, LIB_INVARG); \
} \
else \
SETERRNO(EBADF, SS_IVCHAN)
{
if (PerlIOValid(f)) {
PerlIO_funcs *tab = PerlIOBase(f)->tab;
- PerlIO *new;
PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param);
- new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param, flags);
- return new;
- }
- else {
- SETERRNO(EBADF, SS_IVCHAN);
- return NULL;
+ if (tab && tab->Dup)
+ return (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX), f, param, flags);
- SETERRNO(EINVAL, LIB_INVARG);
++ else {
++ return PerlIOBase_dup(aTHX_ PerlIO_allocate(aTHX), f, param, flags);
++ }
}
+ else
+ SETERRNO(EBADF, SS_IVCHAN);
+
+ return NULL;
}
void
XS(XS_PerlIO__Layer__NoWarnings)
{
-- /* This is used as a %SIG{__WARN__} handler to supress warnings
++ /* This is used as a %SIG{__WARN__} handler to supress warnings
during loading of layers.
*/
dXSARGS;
int
PerlIO__close(pTHX_ PerlIO *f)
{
-- if (PerlIOValid(f))
-- return (*PerlIOBase(f)->tab->Close) (aTHX_ f);
++ if (PerlIOValid(f)) {
++ PerlIO_funcs *tab = PerlIOBase(f)->tab;
++ if (tab && tab->Close)
++ return (*tab->Close)(aTHX_ f);
++ else
++ return PerlIOBase_close(aTHX_ f);
++ }
else {
SETERRNO(EBADF, SS_IVCHAN);
return -1;
int
Perl_PerlIO_close(pTHX_ PerlIO *f)
{
-- int code = -1;
--
-- if (PerlIOValid(f)) {
-- PerlIO_funcs *tab = PerlIOBase(f)->tab;
--
-- if (tab && tab->Close) {
-- code = (*tab->Close)(aTHX_ f);
-- while (*f) {
-- PerlIO_pop(aTHX_ f);
-- }
-- }
-- else
-- PerlIOBase_close(aTHX_ f);
++ int code = PerlIO__close(aTHX_ f);
++ while (PerlIOValid(f)) {
++ PerlIO_pop(aTHX_ f);
}
--
return code;
}
return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
else
SETERRNO(EBADF, SS_IVCHAN);
--
++
return -1;
}
IV
PerlIOBase_close(pTHX_ PerlIO *f)
{
-- IV code = 0;
-- PerlIO *n = PerlIONext(f);
-- if (PerlIO_flush(f) != 0)
-- code = -1;
-- if (PerlIOValid(n) && (*PerlIOBase(n)->tab->Close)(aTHX_ n) != 0)
-- code = -1;
-- PerlIOBase(f)->flags &=
-- ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN);
++ IV code = -1;
++ if (PerlIOValid(f)) {
++ PerlIO *n = PerlIONext(f);
++ code = PerlIO_flush(f);
++ PerlIOBase(f)->flags &=
++ ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN);
++ while (PerlIOValid(n)) {
++ PerlIO_funcs *tab = PerlIOBase(n)->tab;
++ if (tab && tab->Close) {
++ if ((*tab->Close)(aTHX_ n) != 0)
++ code = -1;
++ break;
++ }
++ else {
++ PerlIOBase(n)->flags &=
++ ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN);
++ }
++ n = PerlIONext(n);
++ }
++ }
++ else {
++ SETERRNO(EBADF, SS_IVCHAN);
++ }
return code;
}
PerlIO *nexto = PerlIONext(o);
if (PerlIOValid(nexto)) {
PerlIO_funcs *tab = PerlIOBase(nexto)->tab;
-- f = (*tab->Dup)(aTHX_ f, nexto, param, flags);
++ if (tab && tab->Dup)
++ f = (*tab->Dup)(aTHX_ f, nexto, param, flags);
++ else
++ f = PerlIOBase_dup(aTHX_ f, nexto, param, flags);
}
if (f) {
PerlIO_funcs *self = PerlIOBase(o)->tab;
char buf[8];
PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",
self->name, (void*)f, (void*)o, (void*)param);
- if (self->Getarg) {
- arg = (*self->Getarg)(aTHX_ o,param,flags);
+ if (self->Getarg)
+ arg = (*self->Getarg)(aTHX_ o, param, flags);
+ else {
- arg = Nullsv;
- SETERRNO(EINVAL, LIB_INVARG);
++ arg = Nullsv;
}
f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
if (arg) {
PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
{
/* XXX this could use PerlIO_canset_fileno() and
-- * PerlIO_set_fileno() support from Configure
++ * PerlIO_set_fileno() support from Configure
*/
# if defined(__GLIBC__)
/* There may be a better way for GLIBC:
-- - libio.h defines a flag to not close() on cleanup
++ - libio.h defines a flag to not close() on cleanup
*/
f->_fileno = -1;
return 1;
* long __pad[16];
* };
*
-- * It turns out that the fd is stored in the top 32 bits of
++ * It turns out that the fd is stored in the top 32 bits of
* file->__pad[4]. The lower 32 bits contain flags. file->pad[5] appears
* to contain a pointer or offset into another structure. All the
* remaining fields are zero.
f->__pad[4] |= 0xffffffff00000000L;
assert(fileno(f) == 0xffffffff);
# else /* !defined(_LP64) */
-- /* _file is just a unsigned char :-(
-- Not clear why we dup() rather than using -1
-- even if that would be treated as 0xFF - so will
++ /* _file is just a unsigned char :-(
++ Not clear why we dup() rather than using -1
++ even if that would be treated as 0xFF - so will
a dup fail ...
*/
f->_file = PerlLIO_dup(fileno(f));
f->__fileL = 0xff;
return 1;
/* Next one ->_file seems to be a reasonable fallback, i.e. if
-- your platform does not have special entry try this one.
++ your platform does not have special entry try this one.
[For OSF only have confirmation for Tru64 (alpha)
but assume other OSFs will be similar.]
-- */
++ */
# elif defined(_AIX) || defined(__osf__) || defined(__irix__)
f->_file = -1;
return 1;
# elif defined(__FreeBSD__)
/* There may be a better way on FreeBSD:
-- - we could insert a dummy func in the _close function entry
-- f->_close = (int (*)(void *)) dummy_close;
++ - we could insert a dummy func in the _close function entry
++ f->_close = (int (*)(void *)) dummy_close;
*/
f->_file = -1;
return 1;
# elif defined(__CYGWIN__)
/* There may be a better way on CYGWIN:
-- - we could insert a dummy func in the _close function entry
-- f->_close = (int (*)(void *)) dummy_close;
++ - we could insert a dummy func in the _close function entry
++ f->_close = (int (*)(void *)) dummy_close;
*/
f->_file = -1;
return 1;
return 1;
# else
#if 0
-- /* Sarathy's code did this - we fall back to a dup/dup2 hack
++ /* Sarathy's code did this - we fall back to a dup/dup2 hack
(which isn't thread safe) instead
-- */
++ */
# error "Don't know how to set FILE.fileno on your platform"
#endif
return 0;
int saveerr = 0;
int dupfd = 0;
#ifdef SOCKS5_VERSION_NAME
-- /* Socks lib overrides close() but stdio isn't linked to
-- that library (though we are) - so we must call close()
-- on sockets on stdio's behalf.
-- */
++ /* Socks lib overrides close() but stdio isn't linked to
++ that library (though we are) - so we must call close()
++ on sockets on stdio's behalf.
++ */
int optval;
Sock_size_t optlen = sizeof(int);
if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0) {
socksfd = 1;
-- invalidate = 1;
++ invalidate = 1;
}
#endif
if (PerlIOUnix_refcnt_dec(fd) > 0) {
/* File descriptor still in use */
invalidate = 1;
socksfd = 0;
-- }
++ }
if (invalidate) {
-- /* For STD* handles don't close the stdio at all
-- this is because we have shared the FILE * too
++ /* For STD* handles don't close the stdio at all
++ this is because we have shared the FILE * too
*/
if (stdio == stdin) {
/* Some stdios are buggy fflush-ing inputs */
else if (stdio == stdout || stdio == stderr) {
return PerlIO_flush(f);
}
-- /* Tricky - must fclose(stdio) to free memory but not close(fd)
-- Use Sarathy's trick from maint-5.6 to invalidate the
-- fileno slot of the FILE *
-- */
++ /* Tricky - must fclose(stdio) to free memory but not close(fd)
++ Use Sarathy's trick from maint-5.6 to invalidate the
++ fileno slot of the FILE *
++ */
result = PerlIO_flush(f);
saveerr = errno;
if (!(invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio))) {
dupfd = PerlLIO_dup(fd);
}
-- }
++ }
result = PerlSIO_fclose(stdio);
-- /* We treat error from stdio as success if we invalidated
-- errno may NOT be expected EBADF
++ /* We treat error from stdio as success if we invalidated
++ errno may NOT be expected EBADF
*/
if (invalidate && result != 0) {
errno = saveerr;
result = 0;
-- }
++ }
if (socksfd) {
/* in SOCKS case let close() determine return value */
result = close(fd);
close(dupfd);
}
return result;
-- }
++ }
}
SSize_t
* b->posn is file position where b->buf was read, or will be written
*/
Off_t posn = b->posn;
-- if ((PerlIOBase(f)->flags & PERLIO_F_APPEND) &&
++ if ((PerlIOBase(f)->flags & PERLIO_F_APPEND) &&
(PerlIOBase(f)->flags & PERLIO_F_WRBUF)) {
#if 1
/* As O_APPEND files are normally shared in some sense it is better
*/
PerlIO_flush(f);
#else
-- /* when file is NOT shared then this is sufficient */
++ /* when file is NOT shared then this is sufficient */
PerlIO_seek(PerlIONext(f),0, SEEK_END);
#endif
posn = b->posn = PerlIO_tell(PerlIONext(f));
projects / platform / upstream / perl.git / commitdiff