diff options
| -rw-r--r-- | MANIFEST | 4 | ||||
| -rw-r--r-- | doio.c | 6 | ||||
| -rw-r--r-- | ext/Encode/Encode.xs | 2 | ||||
| -rw-r--r-- | ext/PerlIO/Scalar/Makefile.PL | 6 | ||||
| -rw-r--r-- | ext/PerlIO/Scalar/Scalar.pm | 6 | ||||
| -rw-r--r-- | ext/PerlIO/Scalar/Scalar.xs | 231 | ||||
| -rw-r--r-- | perlio.c | 272 | ||||
| -rw-r--r-- | perliol.h | 4 | ||||
| -rwxr-xr-x | t/io/open.t | 17 | ||||
| -rwxr-xr-x | t/io/utf8.t | 7 | ||||
| -rw-r--r-- | t/lib/io_scalar.t | 35 |
11 files changed, 479 insertions, 111 deletions
@@ -394,6 +394,9 @@ ext/POSIX/hints/openbsd.pl Hint for POSIX for named architecture ext/POSIX/hints/sunos_4.pl Hint for POSIX for named architecture ext/POSIX/hints/svr4.pl Hint for POSIX for named architecture ext/POSIX/typemap POSIX extension interface types +ext/PerlIO/Scalar/Makefile.PL PerlIO layer for scalars +ext/PerlIO/Scalar/Scalar.pm PerlIO layer for scalars +ext/PerlIO/Scalar/Scalar.xs PerlIO layer for scalars ext/SDBM_File/Makefile.PL SDBM extension makefile writer ext/SDBM_File/SDBM_File.pm SDBM extension Perl module ext/SDBM_File/SDBM_File.xs SDBM extension external subroutines @@ -1471,6 +1474,7 @@ t/lib/io_linenum.t See if I/O line numbers are tracked correctly t/lib/io_multihomed.t See if INET sockets work with multi-homed hosts t/lib/io_pipe.t See if pipe()-related methods from IO work t/lib/io_poll.t See if poll()-related methods from IO work +t/lib/io_scalar.t Test of PerlIO::Scalar t/lib/io_sel.t See if select()-related methods from IO work t/lib/io_sock.t See if INET socket-related methods from IO work t/lib/io_taint.t See if the untaint method from IO works @@ -211,7 +211,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (num_svs) { /* New style explict name, type is just mode and discipline/layer info */ STRLEN l; - name = SvPV(*svp, l) ; + name = SvOK(*svp) ? SvPV(*svp, l) : ""; len = (I32)l; name = savepvn(name, len); SAVEFREEPV(name); @@ -512,7 +512,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } } - if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) { + if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && + /* FIXME: This next term is a hack to avoid fileno on PerlIO::Scalar */ + !(num_svs && SvROK(*svp))) { if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) { (void)PerlIO_close(fp); goto say_false; diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs index fea83aec4a..74303c9389 100644 --- a/ext/Encode/Encode.xs +++ b/ext/Encode/Encode.xs @@ -339,7 +339,7 @@ PerlIO_funcs PerlIO_encode = { PerlIOBase_eof, PerlIOBase_error, PerlIOBase_clearerr, - PerlIOBuf_setlinebuf, + PerlIOBase_setlinebuf, PerlIOEncode_get_base, PerlIOBuf_bufsiz, PerlIOBuf_get_ptr, diff --git a/ext/PerlIO/Scalar/Makefile.PL b/ext/PerlIO/Scalar/Makefile.PL new file mode 100644 index 0000000000..81fe5139e6 --- /dev/null +++ b/ext/PerlIO/Scalar/Makefile.PL @@ -0,0 +1,6 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => "PerlIO::Scalar", + VERSION_FROM => 'Scalar.pm', +); + diff --git a/ext/PerlIO/Scalar/Scalar.pm b/ext/PerlIO/Scalar/Scalar.pm new file mode 100644 index 0000000000..e733a72c1b --- /dev/null +++ b/ext/PerlIO/Scalar/Scalar.pm @@ -0,0 +1,6 @@ +package PerlIO::Scalar; +our $VERSION = '0.01'; +use XSLoader (); +XSLoader::load 'PerlIO::Scalar'; +1; +__END__ diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs new file mode 100644 index 0000000000..650cc5a67a --- /dev/null +++ b/ext/PerlIO/Scalar/Scalar.xs @@ -0,0 +1,231 @@ +#define PERL_NO_GET_CONTEXT +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#ifdef PERLIO_LAYERS + +#include "perliol.h" + +typedef struct +{ + struct _PerlIO base; /* Base "class" info */ + SV * var; + Off_t posn; +} PerlIOScalar; + +IV +PerlIOScalar_pushed(PerlIO *f, const char *mode, SV *arg) +{ + PerlIOScalar *b = PerlIOSelf(f,PerlIOScalar); + return PerlIOBase_pushed(f,mode,arg); +} + +IV +PerlIOScalar_popped(PerlIO *f) +{ + PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); + if (s->var) + { + dTHX; + SvREFCNT_dec(s->var); + s->var = Nullsv; + } + return 0; +} + +IV +PerlIOScalar_close(PerlIO *f) +{ + dTHX; + IV code = PerlIOBase_close(f); + PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); + PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF); + return code; +} + +IV +PerlIOScalar_fileno(PerlIO *f) +{ + return -1; +} + +IV +PerlIOScalar_seek(PerlIO *f, Off_t offset, int whence) +{ + PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); + switch(whence) + { + case 0: + s->posn = offset; + break; + case 1: + s->posn = offset + s->posn; + break; + case 2: + s->posn = offset + SvCUR(s->var); + break; + } + if (s->posn > SvCUR(s->var)) + { + dTHX; + (void) SvGROW(s->var,s->posn); + } + return 0; +} + +Off_t +PerlIOScalar_tell(PerlIO *f) +{ + PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); + return s->posn; +} + +SSize_t +PerlIOScalar_unread(PerlIO *f, const void *vbuf, Size_t count) +{ + dTHX; + PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); + char *dst = SvGROW(s->var,s->posn+count); + Move(vbuf,dst,count,char); + s->posn += count; + SvCUR_set(s->var,s->posn); + SvPOK_on(s->var); + return count; +} + +SSize_t +PerlIOScalar_write(PerlIO *f, const void *vbuf, Size_t count) +{ + if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) + { + return PerlIOScalar_unread(f,vbuf,count); + } + return 0; +} + +IV +PerlIOScalar_fill(PerlIO *f) +{ + return -1; +} + +IV +PerlIOScalar_flush(PerlIO *f) +{ + return 0; +} + +STDCHAR * +PerlIOScalar_get_base(PerlIO *f) +{ + PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); + if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) + { + dTHX; + return (STDCHAR *)SvPV_nolen(s->var); + } +} + +STDCHAR * +PerlIOScalar_get_ptr(PerlIO *f) +{ + if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) + { + PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); + return PerlIOScalar_get_base(f)+s->posn; + } + return (STDCHAR *) Nullch; +} + +SSize_t +PerlIOScalar_get_cnt(PerlIO *f) +{ + if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) + { + PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); + return SvCUR(s->var) - s->posn; + } + return 0; +} + +Size_t +PerlIOScalar_bufsiz(PerlIO *f) +{ + if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) + { + PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); + return SvCUR(s->var); + } + return 0; +} + +void +PerlIOScalar_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt) +{ + PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); + s->posn = SvCUR(s->var)-cnt; +} + +PerlIO * +PerlIOScalar_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) +{ + PerlIOScalar *s; + if (narg > 0) + { + SV *ref = *args; + if (SvROK(ref)) + { + SV *var = SvRV(ref); + sv_upgrade(var,SVt_PV); + f = PerlIO_allocate(aTHX); + s = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,PerlIOArg),PerlIOScalar); + s->var = SvREFCNT_inc(var); + s->posn = 0; + PerlIOBase(f)->flags |= PERLIO_F_OPEN; + return f; + } + } + return NULL; +} + + +PerlIO_funcs PerlIO_scalar = { + "Scalar", + sizeof(PerlIOScalar), + PERLIO_K_BUFFERED, + PerlIOScalar_pushed, + PerlIOScalar_popped, + PerlIOScalar_open, + NULL, + PerlIOScalar_fileno, + PerlIOBase_read, + PerlIOScalar_unread, + PerlIOScalar_write, + PerlIOScalar_seek, + PerlIOScalar_tell, + PerlIOScalar_close, + PerlIOScalar_flush, + PerlIOScalar_fill, + PerlIOBase_eof, + PerlIOBase_error, + PerlIOBase_clearerr, + PerlIOBase_setlinebuf, + PerlIOScalar_get_base, + PerlIOScalar_bufsiz, + PerlIOScalar_get_ptr, + PerlIOScalar_get_cnt, + PerlIOScalar_set_ptrcnt, +}; + + +#endif /* Layers available */ + +MODULE = PerlIO::Scalar PACKAGE = PerlIO::Scalar + +BOOT: +{ +#ifdef PERLIO_LAYERS + PerlIO_define_layer(aTHX_ &PerlIO_scalar); +#endif +} + @@ -106,20 +106,25 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int { if (narg == 1) { - char *name = SvPV_nolen(*args); - if (*mode == '#') - { - fd = PerlLIO_open3(name,imode,perm); - if (fd >= 0) - return PerlIO_fdopen(fd,mode+1); - } - else if (old) - { - return PerlIO_reopen(name,mode,old); - } + if (*args == &PL_sv_undef) + return PerlIO_tmpfile(); else { - return PerlIO_open(name,mode); + char *name = SvPV_nolen(*args); + if (*mode == '#') + { + fd = PerlLIO_open3(name,imode,perm); + if (fd >= 0) + return PerlIO_fdopen(fd,mode+1); + } + else if (old) + { + return PerlIO_reopen(name,mode,old); + } + else + { + return PerlIO_open(name,mode); + } } } else @@ -584,9 +589,6 @@ PerlIO_arg_fetch(pTHX_ AV *av,IV n) return (svp) ? *svp : Nullsv; } -#define MYARG PerlIO_arg_fetch(aTHX_ layers,n+1) - - PerlIO_funcs * PerlIO_layer_fetch(pTHX_ AV *av,IV n,PerlIO_funcs *def) { @@ -598,7 +600,7 @@ PerlIO_layer_fetch(pTHX_ AV *av,IV n,PerlIO_funcs *def) return INT2PTR(PerlIO_funcs *, SvIV(layer)); } if (!def) - Perl_croak(aTHX_ "panic:layer array corrupt"); + Perl_croak(aTHX_ "panic:PerlIO layer array corrupt"); return def; } @@ -750,7 +752,7 @@ PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode, AV *layers, IV n) PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers,n,NULL); if (tab) { - if (!PerlIO_push(aTHX_ f,tab,mode,MYARG)) + if (!PerlIO_push(aTHX_ f,tab,mode,PerlIOArg)) { code -1; break; @@ -832,10 +834,14 @@ int PerlIO_close(PerlIO *f) { dTHX; - int code = (*PerlIOBase(f)->tab->Close)(f); - while (*f) + int code = -1; + if (f && *f) { - PerlIO_pop(aTHX_ f); + code = (*PerlIOBase(f)->tab->Close)(f); + while (*f) + { + PerlIO_pop(aTHX_ f); + } } return code; } @@ -877,26 +883,70 @@ AV * PerlIO_resolve_layers(pTHX_ const char *layers,const char *mode,int narg, SV **args) { AV *def = PerlIO_default_layers(aTHX); + int incdef = 1; if (!_perlio) PerlIO_stdstreams(aTHX); - /* FIXME !!! */ + if (narg) + { + if (SvROK(*args)) + { + if (sv_isobject(*args)) + { + SV *handler = PerlIO_find_layer(aTHX_ "object",6); + if (handler) + { + def = newAV(); + av_push(def,handler); + av_push(def,&PL_sv_undef); + incdef = 0; + } + } + else + { + if (SvTYPE(SvRV(*args)) < SVt_PVAV) + { + SV *handler = PerlIO_find_layer(aTHX_ "Scalar",6); + if (handler) + { + def = newAV(); + av_push(def,handler); + av_push(def,&PL_sv_undef); + incdef = 0; + } + } + else + { + Perl_croak(aTHX_ "Unsupported reference arg to open()"); + } + } + } + } if (!layers) layers = PerlIO_context_layers(aTHX_ mode); if (layers && *layers) { - AV *av = newAV(); - IV n = av_len(def)+1; - while (n-- > 0) + AV *av; + if (incdef) { - SV **svp = av_fetch(def,n,0); - av_store(av,n,(svp) ? SvREFCNT_inc(*svp) : &PL_sv_undef); + IV n = av_len(def)+1; + av = newAV(); + while (n-- > 0) + { + SV **svp = av_fetch(def,n,0); + av_store(av,n,(svp) ? SvREFCNT_inc(*svp) : &PL_sv_undef); + } + } + else + { + av = def; } PerlIO_parse_layers(aTHX_ av,layers); return av; } else { - SvREFCNT_inc(def); + if (incdef) + SvREFCNT_inc(def); return def; } } @@ -904,54 +954,68 @@ PerlIO_resolve_layers(pTHX_ const char *layers,const char *mode,int narg, SV **a PerlIO * PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) { - AV *layera; - IV n; - PerlIO_funcs *tab; - if (f && *f) + if (!f && narg == 1 && *args == &PL_sv_undef) { - PerlIOl *l = *f; - layera = newAV(); - while (l) + if ((f = PerlIO_tmpfile())) { - SV *arg = (l->tab->Getarg) ? (*l->tab->Getarg)(&l) : &PL_sv_undef; - av_unshift(layera,2); - av_store(layera,0,PerlIO_tab_sv(aTHX_ l->tab)); - av_store(layera,1,arg); - l = *PerlIONext(&l); + if (!layers) + layers = PerlIO_context_layers(aTHX_ mode); + if (layers && *layers) + PerlIO_apply_layers(aTHX_ f,mode,layers); } } else { - layera = PerlIO_resolve_layers(aTHX_ layers, mode, narg, args); - } - n = av_len(layera)-1; - while (n >= 0) - { - PerlIO_funcs *t = PerlIO_layer_fetch(aTHX_ layera,n,NULL); - if (t && t->Open) + AV *layera; + IV n; + PerlIO_funcs *tab; + if (f && *f) { - tab = t; - break; + /* This is "reopen" - it is not tested as perl does not use it yet */ + PerlIOl *l = *f; + layera = newAV(); + while (l) + { + SV *arg = (l->tab->Getarg) ? (*l->tab->Getarg)(&l) : &PL_sv_undef; + av_unshift(layera,2); + av_store(layera,0,PerlIO_tab_sv(aTHX_ l->tab)); + av_store(layera,1,arg); + l = *PerlIONext(&l); + } } - n -= 2; - } - if (tab) - { - PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n", - tab->name,layers,mode,fd,imode,perm,f,narg,args); - f = (*tab->Open)(aTHX_ tab, layera, n, mode,fd,imode,perm,f,narg,args); - if (f) + else + { + layera = PerlIO_resolve_layers(aTHX_ layers, mode, narg, args); + } + n = av_len(layera)-1; + while (n >= 0) + { + PerlIO_funcs *t = PerlIO_layer_fetch(aTHX_ layera,n,NULL); + if (t && t->Open) + { + tab = t; + break; + } + n -= 2; + } + if (tab) { - if (n+2 < av_len(layera)+1) + PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n", + tab->name,layers,mode,fd,imode,perm,f,narg,args); + f = (*tab->Open)(aTHX_ tab, layera, n, mode,fd,imode,perm,f,narg,args); + if (f) { - if (PerlIO_apply_layera(aTHX_ f, mode, layera, n+2) != 0) + if (n+2 < av_len(layera)+1) { - f = NULL; + if (PerlIO_apply_layera(aTHX_ f, mode, layera, n+2) != 0) + { + f = NULL; + } } } } + SvREFCNT_dec(layera); } - SvREFCNT_dec(layera); return f; } @@ -1434,6 +1498,37 @@ PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count) return done; } +SSize_t +PerlIOBase_read(PerlIO *f, void *vbuf, Size_t count) +{ + STDCHAR *buf = (STDCHAR *) vbuf; + if (f) + { + if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) + return 0; + while (count > 0) + { + SSize_t avail = PerlIO_get_cnt(f); + SSize_t take = (count < avail) ? count : avail; + if (take > 0) + { + STDCHAR *ptr = PerlIO_get_ptr(f); + Copy(ptr,buf,take,STDCHAR); + PerlIO_set_ptrcnt(f,ptr+take,(avail -= take)); + count -= take; + buf += take; + } + if (count > 0 && avail <= 0) + { + if (PerlIO_fill(f) != 0) + break; + } + } + return (buf - (STDCHAR *) vbuf); + } + return 0; +} + IV PerlIOBase_noop_ok(PerlIO *f) { @@ -1453,7 +1548,7 @@ PerlIOBase_close(PerlIO *f) PerlIO *n = PerlIONext(f); if (PerlIO_flush(f) != 0) code = -1; - if (n && (*PerlIOBase(n)->tab->Close)(n) != 0) + if (n && *n && (*PerlIOBase(n)->tab->Close)(n) != 0) code = -1; PerlIOBase(f)->flags &= ~(PERLIO_F_CANREAD|PERLIO_F_CANWRITE|PERLIO_F_OPEN); return code; @@ -1494,7 +1589,10 @@ PerlIOBase_clearerr(PerlIO *f) void PerlIOBase_setlinebuf(PerlIO *f) { - + if (f) + { + PerlIOBase(f)->flags |= PERLIO_F_LINEBUF; + } } /*--------------------------------------------------------------------------------------*/ @@ -1617,7 +1715,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, in if (!f) { f = PerlIO_allocate(aTHX); - s = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,MYARG),PerlIOUnix); + s = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,PerlIOArg),PerlIOUnix); } else s = PerlIOSelf(f,PerlIOUnix); @@ -1837,7 +1935,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, i if (stdio) { PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ (f = PerlIO_allocate(aTHX)), self, - (mode = PerlIOStdio_mode(mode,tmode)),MYARG), + (mode = PerlIOStdio_mode(mode,tmode)),PerlIOArg), PerlIOStdio); s->stdio = stdio; } @@ -1874,7 +1972,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, i } if (stdio) { - PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ (f = PerlIO_allocate(aTHX)),self,mode,MYARG),PerlIOStdio); + PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ (f = PerlIO_allocate(aTHX)),self,mode,PerlIOArg),PerlIOStdio); s->stdio = stdio; return f; } @@ -2228,7 +2326,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, int PerlIO *next = PerlIONext(f); PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n-2, PerlIOBase(next)->tab); next = (*tab->Open)(aTHX_ tab, layers, n-2, mode,fd,imode,perm,next,narg,args); - if (!next || (*PerlIOBase(f)->tab->Pushed)(f,mode,MYARG) != 0) + if (!next || (*PerlIOBase(f)->tab->Pushed)(f,mode,PerlIOArg) != 0) { return NULL; } @@ -2245,7 +2343,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, int f = (*tab->Open)(aTHX_ tab, layers, n-2, mode,fd,imode,perm,NULL,narg,args); if (f) { - PerlIOBuf *b = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,MYARG),PerlIOBuf); + PerlIOBuf *b = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,PerlIOArg),PerlIOBuf); fd = PerlIO_fileno(f); #if O_BINARY != O_TEXT /* do something about failing setmode()? --jhi */ @@ -2384,32 +2482,11 @@ SSize_t PerlIOBuf_read(PerlIO *f, void *vbuf, Size_t count) { PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); - STDCHAR *buf = (STDCHAR *) vbuf; if (f) { if (!b->ptr) PerlIO_get_base(f); - if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) - return 0; - while (count > 0) - { - SSize_t avail = PerlIO_get_cnt(f); - SSize_t take = (count < avail) ? count : avail; - if (take > 0) - { - STDCHAR *ptr = PerlIO_get_ptr(f); - Copy(ptr,buf,take,STDCHAR); - PerlIO_set_ptrcnt(f,ptr+take,(avail -= take)); - count -= take; - buf += take; - } - if (count > 0 && avail <= 0) - { - if (PerlIO_fill(f) != 0) - break; - } - } - return (buf - (STDCHAR *) vbuf); + return PerlIOBase_read(f,vbuf,count); } return 0; } @@ -2551,15 +2628,6 @@ PerlIOBuf_close(PerlIO *f) return code; } -void -PerlIOBuf_setlinebuf(PerlIO *f) -{ - if (f) - { - PerlIOBase(f)->flags &= ~PERLIO_F_LINEBUF; - } -} - STDCHAR * PerlIOBuf_get_ptr(PerlIO *f) { @@ -2646,7 +2714,7 @@ PerlIO_funcs PerlIO_perlio = { PerlIOBase_eof, PerlIOBase_error, PerlIOBase_clearerr, - PerlIOBuf_setlinebuf, + PerlIOBase_setlinebuf, PerlIOBuf_get_base, PerlIOBuf_bufsiz, PerlIOBuf_get_ptr, @@ -2761,7 +2829,7 @@ PerlIO_funcs PerlIO_pending = { PerlIOBase_eof, PerlIOBase_error, PerlIOBase_clearerr, - PerlIOBuf_setlinebuf, + PerlIOBase_setlinebuf, PerlIOBuf_get_base, PerlIOBuf_bufsiz, PerlIOBuf_get_ptr, @@ -3067,7 +3135,7 @@ PerlIO_funcs PerlIO_crlf = { PerlIOBase_eof, PerlIOBase_error, PerlIOBase_clearerr, - PerlIOBuf_setlinebuf, + PerlIOBase_setlinebuf, PerlIOBuf_get_base, PerlIOBuf_bufsiz, PerlIOBuf_get_ptr, @@ -3372,7 +3440,7 @@ PerlIO_funcs PerlIO_mmap = { PerlIOBase_eof, PerlIOBase_error, PerlIOBase_clearerr, - PerlIOBuf_setlinebuf, + PerlIOBase_setlinebuf, PerlIOMmap_get_base, PerlIOBuf_bufsiz, PerlIOBuf_get_ptr, @@ -93,6 +93,8 @@ EXT PerlIO_funcs PerlIO_mmap; #endif extern PerlIO *PerlIO_allocate(pTHX); +extern SV *PerlIO_arg_fetch(pTHX_ AV *av,IV n); +#define PerlIOArg PerlIO_arg_fetch(aTHX_ layers,n+1) #if O_BINARY != O_TEXT #define PERLIO_STDTEXT "t" @@ -106,6 +108,7 @@ extern PerlIO *PerlIO_allocate(pTHX); extern IV PerlIOBase_fileno (PerlIO *f); extern IV PerlIOBase_pushed (PerlIO *f, const char *mode,SV *arg); extern IV PerlIOBase_popped (PerlIO *f); +extern SSize_t PerlIOBase_read (PerlIO *f, void *vbuf, Size_t count); extern SSize_t PerlIOBase_unread (PerlIO *f, const void *vbuf, Size_t count); extern IV PerlIOBase_eof (PerlIO *f); extern IV PerlIOBase_error (PerlIO *f); @@ -145,7 +148,6 @@ extern Off_t PerlIOBuf_tell (PerlIO *f); extern IV PerlIOBuf_close (PerlIO *f); extern IV PerlIOBuf_flush (PerlIO *f); extern IV PerlIOBuf_fill (PerlIO *f); -extern void PerlIOBuf_setlinebuf (PerlIO *f); extern STDCHAR *PerlIOBuf_get_base (PerlIO *f); extern Size_t PerlIOBuf_bufsiz (PerlIO *f); extern STDCHAR *PerlIOBuf_get_ptr (PerlIO *f); diff --git a/t/io/open.t b/t/io/open.t index 635ea4c364..9b37db390c 100755 --- a/t/io/open.t +++ b/t/io/open.t @@ -11,7 +11,7 @@ use warnings; $Is_VMS = $^O eq 'VMS'; $Is_Dos = $^O eq 'dos'; -print "1..66\n"; +print "1..70\n"; my $test = 1; @@ -289,3 +289,18 @@ ok; } ok; } + +# 67..70 - magic temporary file via 3 arg open with undef +{ + open(my $x,"+<",undef) or print "not "; + ok; + print "not " unless defined(fileno($x)); + ok; + select $x; + ok; # goes to $x + select STDOUT; + seek($x,0,0); + print <$x>; + print "not " unless tell($x) > 3; + ok; +} diff --git a/t/io/utf8.t b/t/io/utf8.t index d0201aaffb..07e626f085 100755 --- a/t/io/utf8.t +++ b/t/io/utf8.t @@ -3,8 +3,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; - require Config; import Config; - unless ($Config{'useperlio'}) { + unless (defined &perlio::import) { print "1..0 # Skip: not perlio\n"; exit 0; } @@ -79,7 +78,7 @@ open F, ">:utf8", 'a' or die $!; binmode(F); # we write a "\n" and then tell() - avoid CRLF issues. print F $a; my $y; -{ my $x = tell(F); +{ my $x = tell(F); { use bytes; $y = length($a);} print "not " unless $x == $y; print "ok 16\n"; @@ -99,7 +98,7 @@ print "not ($y) " unless $y == 1; print "ok 18\n"; } -{ my $x = tell(F); +{ my $x = tell(F); { use bytes; $y += 3;} print "not ($x,$y) " unless $x == $y; print "ok 19\n"; diff --git a/t/lib/io_scalar.t b/t/lib/io_scalar.t new file mode 100644 index 0000000000..569abd71e1 --- /dev/null +++ b/t/lib/io_scalar.t @@ -0,0 +1,35 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + unless (defined &perlio::import) { + print "1..0 # Skip: not perlio\n"; + exit 0; + } +} + +$| = 1; +print "1..9\n"; + +my $fh; +my $var = "ok 2\n"; +open($fh,"+<",\$var) or print "not "; +print "ok 1\n"; +print <$fh>; +print "not " unless eof($fh); +print "ok 3\n"; +seek($fh,0,0) or print "not "; +print "not " if eof($fh); +print "ok 4\n"; +print "ok 5\n"; +print $fh "ok 7\n" or print "not "; +print "ok 6\n"; +print $var; +$var = "foo\nbar\n"; +seek($fh,0,0) or print "not "; +print "not " if eof($fh); +print "ok 8\n"; +print "not " unless <$fh> eq "foo\n"; +print "ok 9\n"; + |