mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 08:38:23 +00:00
Change PerlIO_(get|set)pos to take SV *
Should fix, OS/2, VMS, (sfio??) p4raw-id: //depot/perlio@8025
This commit is contained in:
Nick Ing-Simmons
parent
be696b0a6b
commit
766a733e84
41
ext/IO/IO.xs
41
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:
|
||||
|
||||
@ -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_
|
||||
|
||||
14
perlapi.c
14
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)
|
||||
|
||||
77
perlio.c
77
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)
|
||||
|
||||
|
||||
4
perlio.h
4
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 *);
|
||||
|
||||
@ -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()
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user