X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=d9b3d81ac311326e44027bba21a7c4f10e69edf8;hb=ac1d45ba28d946eab50fa4af2a48e56aa1122da1;hp=9c74dd047bd9f6f42542420e497c5abd04c95734;hpb=c411622ed1115558a052ffa629b6bd710abfef5c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perlio.c b/perlio.c index 9c74dd0..d9b3d81 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,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) @@ -563,7 +585,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 +614,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);