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
integrate change#2159 from mainline
[perl5.git]
/
perlio.c
diff --git
a/perlio.c
b/perlio.c
index
b1bf860
..
314881e
100644
(file)
--- a/
perlio.c
+++ b/
perlio.c
@@
-16,7
+16,7
@@
#endif
/*
* This file provides those parts of PerlIO abstraction
#endif
/*
* This file provides those parts of PerlIO abstraction
- * which are not #defined in
perlio
.h.
+ * which are not #defined in
iperlsys
.h.
* Which these are depends on various Configure #ifdef's
*/
* Which these are depends on various Configure #ifdef's
*/
@@
-26,7
+26,7
@@
#ifdef PERLIO_IS_STDIO
void
#ifdef PERLIO_IS_STDIO
void
-PerlIO_init()
+PerlIO_init(
void
)
{
/* Does nothing (yet) except force this file to be included
in perl binary. That allows this file to force inclusion
{
/* Does nothing (yet) except force this file to be included
in perl binary. That allows this file to force inclusion
@@
-37,7
+37,7
@@
PerlIO_init()
#undef PerlIO_tmpfile
PerlIO *
#undef PerlIO_tmpfile
PerlIO *
-PerlIO_tmpfile()
+PerlIO_tmpfile(
void
)
{
return tmpfile();
}
{
return tmpfile();
}
@@
-76,7
+76,7
@@
PerlIO_init()
sfset(sfstdout,SF_SHARE,0);
}
sfset(sfstdout,SF_SHARE,0);
}
-#else
+#else
/* USE_SFIO */
/* Implement all the PerlIO interface using stdio.
- this should be only file to include <stdio.h>
/* Implement all the PerlIO interface using stdio.
- this should be only file to include <stdio.h>
@@
-103,10
+103,6
@@
PerlIO_stdout()
return (PerlIO *) stdout;
}
return (PerlIO *) stdout;
}
-#ifdef HAS_SETLINEBUF
-extern void setlinebuf _((FILE *iop));
-#endif
-
#undef PerlIO_fast_gets
int
PerlIO_fast_gets(f)
#undef PerlIO_fast_gets
int
PerlIO_fast_gets(f)
@@
-149,7
+145,7
@@
PerlIO_set_cnt(f,cnt)
PerlIO *f;
int cnt;
{
PerlIO *f;
int cnt;
{
- if (cnt <
0
)
+ if (cnt <
-1
)
warn("Setting cnt to %d\n",cnt);
#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
FILE_cnt(f) = cnt;
warn("Setting cnt to %d\n",cnt);
#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
FILE_cnt(f) = cnt;
@@
-162,19
+158,19
@@
int cnt;
void
PerlIO_set_ptrcnt(f,ptr,cnt)
PerlIO *f;
void
PerlIO_set_ptrcnt(f,ptr,cnt)
PerlIO *f;
-
char
*ptr;
+
STDCHAR
*ptr;
int cnt;
{
#ifdef FILE_bufsiz
int cnt;
{
#ifdef FILE_bufsiz
-
char *e = (char *)(FILE_base(f) + FILE_bufsiz(f)
);
- int ec
= e - ptr;
- if (ptr > e)
- warn("Setting ptr %p >
base %p\n",ptr, FILE_base(f)+FILE_bufsiz(f)
);
+
STDCHAR *e = FILE_base(f) + FILE_bufsiz(f
);
+ int ec = e - ptr;
+ if (ptr > e
+ 1
)
+ warn("Setting ptr %p >
end+1 %p\n", ptr, e + 1
);
if (cnt != ec)
warn("Setting cnt to %d, ptr implies %d\n",cnt,ec);
#endif
#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
if (cnt != ec)
warn("Setting cnt to %d, ptr implies %d\n",cnt,ec);
#endif
#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
- FILE_ptr(f) =
(STDCHAR *)
ptr;
+ FILE_ptr(f) = ptr;
#else
croak("Cannot set 'ptr' of FILE * on this system");
#endif
#else
croak("Cannot set 'ptr' of FILE * on this system");
#endif
@@
-212,12
+208,12
@@
PerlIO *f;
}
#undef PerlIO_get_ptr
}
#undef PerlIO_get_ptr
-
char
*
+
STDCHAR
*
PerlIO_get_ptr(f)
PerlIO *f;
{
#ifdef FILE_ptr
PerlIO_get_ptr(f)
PerlIO *f;
{
#ifdef FILE_ptr
- return
(char *)
FILE_ptr(f);
+ return FILE_ptr(f);
#else
croak("Cannot get 'ptr' of FILE * on this system");
return NULL;
#else
croak("Cannot get 'ptr' of FILE * on this system");
return NULL;
@@
-225,12
+221,12
@@
PerlIO *f;
}
#undef PerlIO_get_base
}
#undef PerlIO_get_base
-
char
*
+
STDCHAR
*
PerlIO_get_base(f)
PerlIO *f;
{
#ifdef FILE_base
PerlIO_get_base(f)
PerlIO *f;
{
#ifdef FILE_base
- return
(char *)
FILE_base(f);
+ return FILE_base(f);
#else
croak("Cannot get 'base' of FILE * on this system");
return NULL;
#else
croak("Cannot get 'base' of FILE * on this system");
return NULL;
@@
-276,6
+272,15
@@
const char *mode;
return fdopen(fd,mode);
}
return fdopen(fd,mode);
}
+#undef PerlIO_reopen
+PerlIO *
+PerlIO_reopen(name, mode, f)
+const char *name;
+const char *mode;
+PerlIO *f;
+{
+ return freopen(name,mode,f);
+}
#undef PerlIO_close
int
#undef PerlIO_close
int
@@
-293,6
+298,20
@@
PerlIO *f;
return feof(f);
}
return feof(f);
}
+#undef PerlIO_getname
+char *
+PerlIO_getname(f,buf)
+PerlIO *f;
+char *buf;
+{
+#ifdef VMS
+ return fgetname(f,buf);
+#else
+ croak("Don't know how to get file name");
+ return NULL;
+#endif
+}
+
#undef PerlIO_getc
int
PerlIO_getc(f)
#undef PerlIO_getc
int
PerlIO_getc(f)
@@
-341,7
+360,11
@@
PerlIO *f;
#ifdef HAS_SETLINEBUF
setlinebuf(f);
#else
#ifdef HAS_SETLINEBUF
setlinebuf(f);
#else
+# ifdef __BORLANDC__ /* Borland doesn't like NULL size for _IOLBF */
+ setvbuf(f, Nullch, _IOLBF, BUFSIZ);
+# else
setvbuf(f, Nullch, _IOLBF, 0);
setvbuf(f, Nullch, _IOLBF, 0);
+# endif
#endif
}
#endif
}
@@
-351,7
+374,7
@@
PerlIO_putc(f,ch)
PerlIO *f;
int ch;
{
PerlIO *f;
int ch;
{
- putc(ch,f);
+
return
putc(ch,f);
}
#undef PerlIO_ungetc
}
#undef PerlIO_ungetc
@@
-360,25
+383,25
@@
PerlIO_ungetc(f,ch)
PerlIO *f;
int ch;
{
PerlIO *f;
int ch;
{
- ungetc(ch,f);
+
return
ungetc(ch,f);
}
#undef PerlIO_read
}
#undef PerlIO_read
-int
+SSize_t
PerlIO_read(f,buf,count)
PerlIO *f;
void *buf;
PerlIO_read(f,buf,count)
PerlIO *f;
void *buf;
-
s
ize_t count;
+
S
ize_t count;
{
return fread(buf,1,count,f);
}
#undef PerlIO_write
{
return fread(buf,1,count,f);
}
#undef PerlIO_write
-int
+SSize_t
PerlIO_write(f,buf,count)
PerlIO *f;
const void *buf;
PerlIO_write(f,buf,count)
PerlIO *f;
const void *buf;
-
s
ize_t count;
+
S
ize_t count;
{
return fwrite1(buf,1,count,f);
}
{
return fwrite1(buf,1,count,f);
}
@@
-422,22
+445,11
@@
PerlIO *f;
#undef PerlIO_printf
int
#undef PerlIO_printf
int
-#ifdef I_STDARG
PerlIO_printf(PerlIO *f,const char *fmt,...)
PerlIO_printf(PerlIO *f,const char *fmt,...)
-#else
-PerlIO_printf(f,fmt,va_alist)
-PerlIO *f;
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = vfprintf(f,fmt,ap);
va_end(ap);
return result;
result = vfprintf(f,fmt,ap);
va_end(ap);
return result;
@@
-445,21
+457,11
@@
va_dcl
#undef PerlIO_stdoutf
int
#undef PerlIO_stdoutf
int
-#ifdef I_STDARG
PerlIO_stdoutf(const char *fmt,...)
PerlIO_stdoutf(const char *fmt,...)
-#else
-PerlIO_stdoutf(fmt, va_alist)
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
va_end(ap);
return result;
result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
va_end(ap);
return result;
@@
-528,6
+530,17
@@
const Fpos_t *pos;
{
return PerlIO_seek(f,*pos,0);
}
{
return PerlIO_seek(f,*pos,0);
}
+#else
+#ifndef PERLIO_IS_STDIO
+#undef PerlIO_setpos
+int
+PerlIO_setpos(f,pos)
+PerlIO *f;
+const Fpos_t *pos;
+{
+ return fsetpos(f, pos);
+}
+#endif
#endif
#ifndef HAS_FGETPOS
#endif
#ifndef HAS_FGETPOS
@@
-540,12
+553,31
@@
Fpos_t *pos;
*pos = PerlIO_tell(f);
return 0;
}
*pos = PerlIO_tell(f);
return 0;
}
+#else
+#ifndef PERLIO_IS_STDIO
+#undef PerlIO_getpos
+int
+PerlIO_getpos(f,pos)
+PerlIO *f;
+Fpos_t *pos;
+{
+ return fgetpos(f, pos);
+}
+#endif
#endif
#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
int
#endif
#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
int
-vprintf(fd, pat, args)
+vprintf(pat, args)
+char *pat, *args;
+{
+ _doprnt(pat, args, stdout);
+ return 0; /* wrong, but perl doesn't use the return value */
+}
+
+int
+vfprintf(fd, pat, args)
FILE *fd;
char *pat, *args;
{
FILE *fd;
char *pat, *args;
{
@@
-557,16
+589,12
@@
char *pat, *args;
#ifndef PerlIO_vsprintf
int
#ifndef PerlIO_vsprintf
int
-PerlIO_vsprintf(s,n,fmt,ap)
-char *s;
-const char *fmt;
-int n;
-va_list ap;
+PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
{
int val = vsprintf(s, fmt, ap);
if (n >= 0)
{
{
int val = vsprintf(s, fmt, ap);
if (n >= 0)
{
- if (strlen(s) >= n)
+ if (strlen(s) >=
(STRLEN)
n)
{
PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
my_exit(1);
{
PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
my_exit(1);
@@
-578,23
+606,11
@@
va_list ap;
#ifndef PerlIO_sprintf
int
#ifndef PerlIO_sprintf
int
-#ifdef I_STDARG
PerlIO_sprintf(char *s, int n, const char *fmt,...)
PerlIO_sprintf(char *s, int n, const char *fmt,...)
-#else
-PerlIO_sprintf(s, n, fmt, va_alist)
-char *s;
-int n;
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = PerlIO_vsprintf(s, n, fmt, ap);
va_end(ap);
return result;
result = PerlIO_vsprintf(s, n, fmt, ap);
va_end(ap);
return result;