X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=85b036ca9fa205b0c2dc82c6ebbf10398e770ddd;hb=3c10ad8e31f7d77e71c048b1746912f41cb540f0;hp=b1bf8602e92a28e73bde7a5416619f53688842dd;hpb=33dcbb9a4b5517789b5e779cf126923149d7ff89;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perlio.c b/perlio.c index b1bf860..85b036c 100644 --- a/perlio.c +++ b/perlio.c @@ -103,10 +103,6 @@ PerlIO_stdout() return (PerlIO *) stdout; } -#ifdef HAS_SETLINEBUF -extern void setlinebuf _((FILE *iop)); -#endif - #undef PerlIO_fast_gets int PerlIO_fast_gets(f) @@ -149,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; @@ -162,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 @@ -212,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; @@ -225,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; @@ -276,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 @@ -293,6 +298,19 @@ 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"); +#endif +} + #undef PerlIO_getc int PerlIO_getc(f) @@ -528,6 +546,17 @@ const Fpos_t *pos; { 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 @@ -540,6 +569,17 @@ Fpos_t *pos; *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) @@ -566,7 +606,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);