From: Nick Ing-Simmons Date: Thu, 7 Dec 2000 21:43:32 +0000 (+0000) Subject: Change PerlIO_(get|set)pos to take SV * X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=766a733e849204725c27391cf2992d649af4aba6;p=p5sagit%2Fp5-mst-13.2.git Change PerlIO_(get|set)pos to take SV * Should fix, OS/2, VMS, (sfio??) p4raw-id: //depot/perlio@8025 --- diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs index 6da48dc..13b198c 100644 --- a/ext/IO/IO.xs +++ b/ext/IO/IO.xs @@ -59,9 +59,9 @@ io_blocking(InputStream f, int block) if (RETVAL >= 0) { int mode = RETVAL; #ifdef O_NONBLOCK - /* POSIX style */ + /* POSIX style */ #if defined(O_NDELAY) && O_NDELAY != O_NONBLOCK - /* Ooops has O_NDELAY too - make sure we don't + /* Ooops has O_NDELAY too - make sure we don't * get SysV behaviour by mistake. */ /* E.g. In UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY @@ -86,7 +86,7 @@ io_blocking(InputStream f, int block) } } #else - /* Standard POSIX */ + /* Standard POSIX */ RETVAL = RETVAL & O_NONBLOCK ? 0 : 1; if ((block == 0) && !(mode & O_NONBLOCK)) { @@ -103,11 +103,11 @@ io_blocking(InputStream f, int block) if(ret < 0) RETVAL = ret; } -#endif +#endif #else /* Not POSIX - better have O_NDELAY or we can't cope. * for BSD-ish machines this is an acceptable alternative - * for SysV we can't tell "would block" from EOF but that is + * for SysV we can't tell "would block" from EOF but that is * the way SysV is... */ RETVAL = RETVAL & O_NDELAY ? 0 : 1; @@ -141,18 +141,18 @@ fgetpos(handle) InputStream handle CODE: if (handle) { - Fpos_t pos; - if ( #ifdef PerlIO - PerlIO_getpos(handle, &pos) + ST(0) = sv_2mortal(newSV(0)); + if (PerlIO_getpos(handle, ST(0)) != 0) { + ST(0) = &PL_sv_undef; + } #else - fgetpos(handle, &pos) -#endif - ) { + if (fgetpos(handle, &pos)) { ST(0) = &PL_sv_undef; } else { ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); } +#endif } else { ST(0) = &PL_sv_undef; @@ -164,14 +164,21 @@ fsetpos(handle, pos) InputStream handle SV * pos CODE: - char *p; - STRLEN len; - if (handle && (p = SvPV(pos,len)) && len == sizeof(Fpos_t)) + if (handle) { #ifdef PerlIO - RETVAL = PerlIO_setpos(handle, (Fpos_t*)p); + RETVAL = PerlIO_setpos(handle, pos); #else - RETVAL = fsetpos(handle, (Fpos_t*)p); + char *p; + STRLEN len; + if ((p = SvPV(pos,len)) && len == sizeof(Fpos_t)) { + RETVAL = fsetpos(handle, (Fpos_t*)p); + } + else { + RETVAL = -1; + errno = EINVAL; + } #endif + } else { RETVAL = -1; errno = EINVAL; @@ -207,7 +214,7 @@ new_tmpfile(packname = "IO::File") MODULE = IO PACKAGE = IO::Poll -void +void _poll(timeout,...) int timeout; PPCODE: diff --git a/fakesdio.h b/fakesdio.h index 374087f..4791232 100644 --- a/fakesdio.h +++ b/fakesdio.h @@ -71,9 +71,7 @@ #define fread(b,s,c,f) _CANNOT fread #define fwrite(b,s,c,f) _CANNOT fwrite #endif -#define fgetpos(f,p) PerlIO_getpos(f,p) #define fseek(f,o,w) PerlIO_seek(f,o,w) -#define fsetpos(f,p) PerlIO_setpos(f,p) #define ftell(f) PerlIO_tell(f) #define rewind(f) PerlIO_rewind(f) #define clearerr(f) PerlIO_clearerr(f) @@ -84,6 +82,9 @@ #define popen(c,m) my_popen(c,m) #define pclose(f) my_pclose(f) +#define fsetpos(f,p) _CANNOT _fsetpos_ +#define fgetpos(f,p) _CANNOT _fgetpos_ + #define __filbuf(f) _CANNOT __filbuf_ #define _filbuf(f) _CANNOT _filbuf_ #define __flsbuf(c,f) _CANNOT __flsbuf_ diff --git a/perlapi.c b/perlapi.c index 4f3497e..e2df18e 100644 --- a/perlapi.c +++ b/perlapi.c @@ -3227,6 +3227,13 @@ Perl_sv_unref(pTHXo_ SV* sv) ((CPerlObj*)pPerl)->Perl_sv_unref(sv); } +#undef Perl_sv_unref_flags +void +Perl_sv_unref_flags(pTHXo_ SV* sv, U32 flags) +{ + ((CPerlObj*)pPerl)->Perl_sv_unref_flags(sv, flags); +} + #undef Perl_sv_untaint void Perl_sv_untaint(pTHXo_ SV* sv) @@ -3868,6 +3875,13 @@ Perl_sv_force_normal(pTHXo_ SV *sv) ((CPerlObj*)pPerl)->Perl_sv_force_normal(sv); } +#undef Perl_sv_force_normal_flags +void +Perl_sv_force_normal_flags(pTHXo_ SV *sv, U32 flags) +{ + ((CPerlObj*)pPerl)->Perl_sv_force_normal_flags(sv, flags); +} + #undef Perl_tmps_grow void Perl_tmps_grow(pTHXo_ I32 n) diff --git a/perlio.c b/perlio.c index a0856af..874dece 100644 --- a/perlio.c +++ b/perlio.c @@ -239,7 +239,7 @@ PerlIO_allocate(pTHX) if (!f) { return NULL; - } + } *last = f; return f+1; } @@ -318,7 +318,7 @@ PerlIO_find_layer(const char *name, STRLEN len) dTHX; SV **svp; SV *sv; - if (len <= 0) + if ((SSize_t) len <= 0) len = strlen(name); svp = hv_fetch(PerlIO_layer_hv,name,len,0); if (svp && (sv = *svp) && SvROK(sv)) @@ -643,7 +643,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f) Off_t posn = PerlIO_tell(f); PerlIO_seek(new,posn,SEEK_SET); } - return new; + return new; } #undef PerlIO_close @@ -932,7 +932,7 @@ PerlIO_modestr(PerlIO *f,char *buf) { *s++ = '+'; } - } + } else if (flags & PERLIO_F_CANREAD) { *s++ = 'r'; @@ -1298,6 +1298,7 @@ Off_t PerlIOUnix_tell(PerlIO *f) { dTHX; + Off_t posn = PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR); return PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR); } @@ -1367,20 +1368,19 @@ PerlIOStdio_fileno(PerlIO *f) return PerlSIO_fileno(PerlIOSelf(f,PerlIOStdio)->stdio); } -const char * +char * PerlIOStdio_mode(const char *mode,char *tmode) { - const char *ret = mode; + char *ret = tmode; + while (*mode) + { + *tmode++ = *mode++; + } if (O_BINARY != O_TEXT) { - ret = (const char *) tmode; - while (*mode) - { - *tmode++ = *mode++; - } *tmode++ = 'b'; - *tmode = '\0'; } + *tmode = '\0'; return ret; } @@ -3148,47 +3148,70 @@ PerlIO_tmpfile(void) #ifndef HAS_FSETPOS #undef PerlIO_setpos int -PerlIO_setpos(PerlIO *f, const Fpos_t *pos) +PerlIO_setpos(PerlIO *f, SV *pos) { - return PerlIO_seek(f,*pos,0); + dTHX; + if (SvOK(pos)) + { + STRLEN len; + Off_t *posn = (Off_t *) SvPV(pos,len); + if (f && len == sizeof(Off_t)) + return PerlIO_seek(f,*posn,SEEK_SET); + } + errno = EINVAL; + return -1; } #else -#ifndef PERLIO_IS_STDIO #undef PerlIO_setpos int -PerlIO_setpos(PerlIO *f, const Fpos_t *pos) +PerlIO_setpos(PerlIO *f, SV *pos) { + dTHX; + if (SvOK(pos)) + { + STRLEN len; + Fpos_t *fpos = (Fpos_t *) SvPV(pos,len); + if (f && len == sizeof(Fpos_t)) + { #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64) - return fsetpos64(f, pos); + return fsetpos64(f, fpos); #else - return fsetpos(f, pos); + return fsetpos(f, fpos); #endif + } + } + errno = EINVAL; + return -1; } #endif -#endif #ifndef HAS_FGETPOS #undef PerlIO_getpos int -PerlIO_getpos(PerlIO *f, Fpos_t *pos) +PerlIO_getpos(PerlIO *f, SV *pos) { - *pos = PerlIO_tell(f); - return *pos == -1 ? -1 : 0; + dTHX; + Off_t posn = PerlIO_tell(f); + sv_setpvn(pos,(char *)&posn,sizeof(posn)); + return (posn == (Off_t)-1) ? -1 : 0; } #else -#ifndef PERLIO_IS_STDIO #undef PerlIO_getpos int -PerlIO_getpos(PerlIO *f, Fpos_t *pos) +PerlIO_getpos(PerlIO *f, SV *pos) { + dTHX; + Fpos_t fpos; + int code; #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64) - return fgetpos64(f, pos); + code = fgetpos64(f, &fpos); #else - return fgetpos(f, pos); + code = fgetpos(f, &fpos); #endif + sv_setpvn(pos,(char *)&fpos,sizeof(fpos)); + return code; } #endif -#endif #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF) diff --git a/perlio.h b/perlio.h index 574b741..7d4cdcd 100644 --- a/perlio.h +++ b/perlio.h @@ -299,10 +299,10 @@ extern PerlIO * PerlIO_stdout (void); extern PerlIO * PerlIO_stderr (void); #endif #ifndef PerlIO_getpos -extern int PerlIO_getpos (PerlIO *,Fpos_t *); +extern int PerlIO_getpos (PerlIO *,SV *); #endif #ifndef PerlIO_setpos -extern int PerlIO_setpos (PerlIO *,const Fpos_t *); +extern int PerlIO_setpos (PerlIO *,SV *); #endif #ifndef PerlIO_fdupopen extern PerlIO * PerlIO_fdupopen (pTHX_ PerlIO *); diff --git a/perlsdio.h b/perlsdio.h index aaedec4..fd990c0 100644 --- a/perlsdio.h +++ b/perlsdio.h @@ -60,12 +60,6 @@ #else # define PerlIO_seek(f,o,w) fseek(f,o,w) #endif -#ifdef HAS_FGETPOS -#define PerlIO_getpos(f,p) fgetpos(f,p) -#endif -#ifdef HAS_FSETPOS -#define PerlIO_setpos(f,p) fsetpos(f,p) -#endif #define PerlIO_rewind(f) rewind(f) #define PerlIO_tmpfile() tmpfile()