X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=f269dcdb1ded38f14712c5cf98af40d36e56d73d;hb=1d64a758d60d7ded97c59c753fea85d3365ca0df;hp=9c74dd047bd9f6f42542420e497c5abd04c95734;hpb=c411622ed1115558a052ffa629b6bd710abfef5c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perlio.c b/perlio.c index 9c74dd0..f269dcd 100644 --- a/perlio.c +++ b/perlio.c @@ -145,7 +145,7 @@ PerlIO_set_cnt(f,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; @@ -158,19 +158,19 @@ int cnt; void PerlIO_set_ptrcnt(f,ptr,cnt) PerlIO *f; -char *ptr; +STDCHAR *ptr; 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) - FILE_ptr(f) = (STDCHAR *) ptr; + FILE_ptr(f) = ptr; #else croak("Cannot set 'ptr' of FILE * on this system"); #endif @@ -208,12 +208,12 @@ PerlIO *f; } #undef PerlIO_get_ptr -char * +STDCHAR * 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; @@ -221,12 +221,12 @@ PerlIO *f; } #undef PerlIO_get_base -char * +STDCHAR * 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; @@ -272,6 +272,15 @@ const char *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 @@ -289,6 +298,20 @@ PerlIO *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) @@ -337,7 +360,11 @@ PerlIO *f; #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); +# endif #endif } @@ -347,7 +374,7 @@ PerlIO_putc(f,ch) PerlIO *f; int ch; { - putc(ch,f); + return putc(ch,f); } #undef PerlIO_ungetc @@ -356,25 +383,25 @@ PerlIO_ungetc(f,ch) PerlIO *f; int ch; { - ungetc(ch,f); + return ungetc(ch,f); } #undef PerlIO_read -int +SSize_t PerlIO_read(f,buf,count) PerlIO *f; void *buf; -size_t count; +Size_t count; { return fread(buf,1,count,f); } #undef PerlIO_write -int +SSize_t PerlIO_write(f,buf,count) PerlIO *f; const void *buf; -size_t count; +Size_t count; { return fwrite1(buf,1,count,f); } @@ -563,7 +590,15 @@ Fpos_t *pos; #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; { @@ -584,7 +619,7 @@ va_list ap; 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);