#define PERL_IN_PERLIO_C
#include "perl.h"
+#ifdef PERL_IMPLICIT_CONTEXT
+#undef dSYS
+#define dSYS dTHX
+#endif
+
#include "XSUB.h"
int
PerlIO *
PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
{
+#ifndef PERL_MICRO
if (f) {
int fd = PerlLIO_dup(PerlIO_fileno(f));
if (fd >= 0) {
else {
SETERRNO(EBADF, SS$_IVCHAN);
}
+#endif
return NULL;
}
*/
char q = ((*s == '\'') ? '"' : '\'');
Perl_warn(aTHX_
- "perlio: invalid separator character %c%c%c in layer specification list",
- q, *s, q);
+ "perlio: invalid separator character %c%c%c in layer specification list %s",
+ q, *s, q, s);
return -1;
}
do {
/* This assumes no layers underneath - which is what
happens, but is not how I remember it. NI-S 2001/10/16
*/
- int fd = PerlIO_fileno(o);
- if (fd >= 0) {
- char buf[8];
- FILE *stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o, buf));
- if (stdio) {
- if ((f = PerlIOBase_dup(aTHX_ f, o, param))) {
- PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
- PerlIOUnix_refcnt_inc(fd);
- }
- else {
- PerlSIO_fclose(stdio);
- }
- }
- else {
- PerlLIO_close(fd);
- f = NULL;
- }
+ if ((f = PerlIOBase_dup(aTHX_ f, o, param))) {
+ FILE *stdio = PerlIOSelf(o, PerlIOStdio)->stdio;
+ PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
+ PerlIOUnix_refcnt_inc(fileno(stdio));
}
return f;
}
f = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
NULL, narg, args);
if (f) {
- PerlIO_push(aTHX_ f, self, mode, PerlIOArg);
- fd = PerlIO_fileno(f);
+ if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) {
+ /*
+ * if push fails during open, open fails. close will pop us.
+ */
+ PerlIO_close (f);
+ return NULL;
+ } else {
+ fd = PerlIO_fileno(f);
#if (O_BINARY != O_TEXT) && !defined(__BEOS__)
- /*
- * do something about failing setmode()? --jhi
- */
- PerlLIO_setmode(fd, O_BINARY);
-#endif
- if (init && fd == 2) {
/*
- * Initial stderr is unbuffered
+ * do something about failing setmode()? --jhi
*/
- PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+ PerlLIO_setmode(fd, O_BINARY);
+#endif
+ if (init && fd == 2) {
+ /*
+ * Initial stderr is unbuffered
+ */
+ PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+ }
}
}
}
int code;
b->ptr++; /* say we have read it as far as
* flush() is concerned */
- b->buf++; /* Leave space an front of buffer */
+ b->buf++; /* Leave space in front of buffer */
b->bufsiz--; /* Buffer is thus smaller */
code = PerlIO_fill(f); /* Fetch some more */
b->bufsiz++; /* Restore size for next time */