From: Jarkko Hietaniemi Date: Thu, 20 Jun 2002 20:41:20 +0000 (+0000) Subject: Retract #17331, something broke (e.g. t/io/utf8.t became unhappy) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=15af043884e0520355045b5d53efce3cdf6f3094;p=p5sagit%2Fp5-mst-13.2.git Retract #17331, something broke (e.g. t/io/utf8.t became unhappy) p4raw-id: //depot/perl@17332 --- diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs index 5bbc119..314c0f3 100644 --- a/ext/PerlIO/Scalar/Scalar.xs +++ b/ext/PerlIO/Scalar/Scalar.xs @@ -14,7 +14,7 @@ typedef struct } PerlIOScalar; IV -PerlIOScalar_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIOScalar_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { IV code; PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); @@ -38,7 +38,7 @@ PerlIOScalar_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *ta s->var = newSVpvn("",0); } sv_upgrade(s->var,SVt_PV); - code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv,tab); + code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv); if ((PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE) SvCUR(s->var) = 0; if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) @@ -263,7 +263,6 @@ PerlIOScalar_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) } PerlIO_funcs PerlIO_scalar = { - sizeof(PerlIO_funcs), "Scalar", sizeof(PerlIOScalar), PERLIO_K_BUFFERED|PERLIO_K_RAW, diff --git a/ext/PerlIO/Via/Via.xs b/ext/PerlIO/Via/Via.xs index 04c4d48..d1ebab2 100644 --- a/ext/PerlIO/Via/Via.xs +++ b/ext/PerlIO/Via/Via.xs @@ -123,9 +123,9 @@ PerlIOVia_method(pTHX_ PerlIO *f,char *method,CV **save,int flags,...) } IV -PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { - IV code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv,tab); + IV code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv); if (code == 0) { PerlIOVia *s = PerlIOSelf(f,PerlIOVia); @@ -559,7 +559,6 @@ PerlIOVia_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) } PerlIO_funcs PerlIO_object = { - sizeof(PerlIO_funcs), "Via", sizeof(PerlIOVia), PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT, diff --git a/ext/PerlIO/encoding/encoding.xs b/ext/PerlIO/encoding/encoding.xs index a714a3d..df911ed 100644 --- a/ext/PerlIO/encoding/encoding.xs +++ b/ext/PerlIO/encoding/encoding.xs @@ -80,11 +80,11 @@ PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags) } IV -PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs *tab) +PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg) { PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode); dSP; - IV code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv,tab); + IV code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv); SV *result = Nullsv; PUSHSTACKi(PERLSI_MAGIC); @@ -584,7 +584,6 @@ PerlIOEncode_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } PerlIO_funcs PerlIO_encode = { - sizeof(PerlIO_funcs), "encoding", sizeof(PerlIOEncode), PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT, diff --git a/perlio.c b/perlio.c index f8d6517..edfdf17 100644 --- a/perlio.c +++ b/perlio.c @@ -990,33 +990,17 @@ PerlIO_stdstreams(pTHX) PerlIO * PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg) { - if (tab->fsize != sizeof(PerlIO_funcs)) { - mismatch: - Perl_croak(aTHX_ "Layer does not match this perl"); - } - if (tab->size) { - PerlIOl *l = NULL; - if (tab->size < sizeof(PerlIOl)) { - goto mismatch; - } - /* Real layer with a data area */ - Newc('L',l,tab->size,char,PerlIOl); - if (l && f) { - Zero(l, tab->size, char); - l->next = *f; - l->tab = tab; - *f = l; - PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name, - (mode) ? mode : "(Null)", (void*)arg); - if ((*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) { - PerlIO_pop(aTHX_ f); - return NULL; - } - } - } - else if (f) { - /* Pseudo-layer where push does its own stack adjust */ - if ((*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) { + PerlIOl *l = NULL; + Newc('L',l,tab->size,char,PerlIOl); + if (l && f) { + Zero(l, tab->size, char); + l->next = *f; + l->tab = tab; + *f = l; + PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name, + (mode) ? mode : "(Null)", (void*)arg); + if ((*l->tab->Pushed) (aTHX_ f, mode, arg) != 0) { + PerlIO_pop(aTHX_ f); return NULL; } } @@ -1024,7 +1008,7 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg) } IV -PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { PerlIO_pop(aTHX_ f); if (*f) { @@ -1054,12 +1038,13 @@ PerlIOBase_binmode(pTHX_ PerlIO *f) } IV -PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { if (PerlIOValid(f)) { PerlIO *t; PerlIOl *l; + PerlIO_pop(aTHX_ f); /* Remove the dummy layer */ PerlIO_flush(f); /* * Strip all layers that are not suitable for a raw stream @@ -1695,9 +1680,11 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt) */ IV -PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { if (*PerlIONext(f)) { + PerlIO_funcs *tab = PerlIOBase(f)->tab; + PerlIO_pop(aTHX_ f); if (tab->kind & PERLIO_K_UTF8) PerlIOBase(f)->flags |= PERLIO_F_UTF8; else @@ -1708,9 +1695,8 @@ PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) } PerlIO_funcs PerlIO_utf8 = { - sizeof(PerlIO_funcs), "utf8", - 0, + sizeof(PerlIOl), PERLIO_K_DUMMY | PERLIO_K_UTF8, PerlIOUtf8_pushed, NULL, @@ -1737,9 +1723,8 @@ PerlIO_funcs PerlIO_utf8 = { }; PerlIO_funcs PerlIO_byte = { - sizeof(PerlIO_funcs), "bytes", - 0, + sizeof(PerlIOl), PERLIO_K_DUMMY, PerlIOUtf8_pushed, NULL, @@ -1776,9 +1761,8 @@ PerlIORaw_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, } PerlIO_funcs PerlIO_raw = { - sizeof(PerlIO_funcs), "raw", - 0, + sizeof(PerlIOl), PERLIO_K_DUMMY, PerlIORaw_pushed, PerlIOBase_popped, @@ -1846,13 +1830,14 @@ PerlIO_modestr(PerlIO *f, char *buf) } IV -PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { PerlIOl *l = PerlIOBase(f); #if 0 const char *omode = mode; char temp[8]; #endif + PerlIO_funcs *tab = PerlIOBase(f)->tab; l->flags &= ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_TRUNCATE | PERLIO_F_APPEND); if (tab->Set_ptrcnt != NULL) @@ -2210,9 +2195,9 @@ PerlIOUnix_fileno(pTHX_ PerlIO *f) } IV -PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { - IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab); + IV code = PerlIOBase_pushed(aTHX_ f, mode, arg); PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix); if (*PerlIONext(f)) { /* We never call down so do any pending stuff now */ @@ -2380,7 +2365,6 @@ PerlIOUnix_close(pTHX_ PerlIO *f) } PerlIO_funcs PerlIO_unix = { - sizeof(PerlIO_funcs), "unix", sizeof(PerlIOUnix), PERLIO_K_RAW, @@ -2452,7 +2436,7 @@ PerlIOStdio_mode(const char *mode, char *tmode) * This isn't used yet ... */ IV -PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { if (*PerlIONext(f)) { PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio); @@ -2468,7 +2452,7 @@ PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab else return -1; } - return PerlIOBase_pushed(aTHX_ f, mode, arg, tab); + return PerlIOBase_pushed(aTHX_ f, mode, arg); } @@ -2939,7 +2923,6 @@ PerlIOStdio_fill(pTHX_ PerlIO *f) PerlIO_funcs PerlIO_stdio = { - sizeof(PerlIO_funcs), "stdio", sizeof(PerlIOStdio), PERLIO_K_BUFFERED|PERLIO_K_RAW, @@ -3043,7 +3026,7 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f) */ IV -PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); int fd = PerlIO_fileno(f); @@ -3056,7 +3039,7 @@ PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) b->posn = posn; } } - return PerlIOBase_pushed(aTHX_ f, mode, arg, tab); + return PerlIOBase_pushed(aTHX_ f, mode, arg); } PerlIO * @@ -3069,7 +3052,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab); next = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm, next, narg, args); - if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg, self) != 0) { + if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg) != 0) { return NULL; } } @@ -3491,7 +3474,6 @@ PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) PerlIO_funcs PerlIO_perlio = { - sizeof(PerlIO_funcs), "perlio", sizeof(PerlIOBuf), PERLIO_K_BUFFERED|PERLIO_K_RAW, @@ -3581,9 +3563,9 @@ PerlIOPending_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt) } IV -PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { - IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab); + IV code = PerlIOBase_pushed(aTHX_ f, mode, arg); PerlIOl *l = PerlIOBase(f); /* * Our PerlIO_fast_gets must match what we are pushed on, or sv_gets() @@ -3614,7 +3596,6 @@ PerlIOPending_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) } PerlIO_funcs PerlIO_pending = { - sizeof(PerlIO_funcs), "pending", sizeof(PerlIOBuf), PERLIO_K_BUFFERED|PERLIO_K_RAW, /* not sure about RAW here */ @@ -3660,11 +3641,11 @@ typedef struct { } PerlIOCrlf; IV -PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { IV code; PerlIOBase(f)->flags |= PERLIO_F_CRLF; - code = PerlIOBuf_pushed(aTHX_ f, mode, arg, tab); + code = PerlIOBuf_pushed(aTHX_ f, mode, arg); #if 0 PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08" UVxf "\n", f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)", @@ -3925,7 +3906,6 @@ PerlIOCrlf_binmode(pTHX_ PerlIO *f) } PerlIO_funcs PerlIO_crlf = { - sizeof(PerlIO_funcs), "crlf", sizeof(PerlIOCrlf), PERLIO_K_BUFFERED | PERLIO_K_CANCRLF | PERLIO_K_RAW, @@ -4242,7 +4222,6 @@ PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) PerlIO_funcs PerlIO_mmap = { - sizeof(PerlIO_funcs), "mmap", sizeof(PerlIOMmap), PERLIO_K_BUFFERED|PERLIO_K_RAW, diff --git a/perliol.h b/perliol.h index fa399e6..76d74a7 100644 --- a/perliol.h +++ b/perliol.h @@ -14,11 +14,10 @@ struct PerlIO_list_s { }; struct _PerlIO_funcs { - Size_t fsize; char *name; Size_t size; U32 kind; - IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab); + IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg); IV (*Popped) (pTHX_ PerlIO *f); PerlIO *(*Open) (pTHX_ PerlIO_funcs *tab, PerlIO_list_t *layers, IV n, @@ -125,7 +124,7 @@ extern SV *PerlIO_arg_fetch(PerlIO_list_t *av, IV n); extern IV PerlIOBase_fileno(pTHX_ PerlIO *f); extern PerlIO *PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags); -extern IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab); +extern IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg); extern IV PerlIOBase_popped(pTHX_ PerlIO *f); extern IV PerlIOBase_binmode(pTHX_ PerlIO *f); extern SSize_t PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count); @@ -169,7 +168,7 @@ extern PerlIO *PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args); -extern IV PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab); +extern IV PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg); extern IV PerlIOBuf_popped(pTHX_ PerlIO *f); extern PerlIO *PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags); extern SSize_t PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count); diff --git a/pod/perliol.pod b/pod/perliol.pod index da4abe7..81cbab1 100644 --- a/pod/perliol.pod +++ b/pod/perliol.pod @@ -87,11 +87,10 @@ same as the public C functions: struct _PerlIO_funcs { - Size_t fsize; char * name; Size_t size; IV kind; - IV (*Pushed)(pTHX_ PerlIO *f,const char *mode,SV *arg, PerlIO_funcs *tab); + IV (*Pushed)(pTHX_ PerlIO *f,const char *mode,SV *arg); IV (*Popped)(pTHX_ PerlIO *f); PerlIO * (*Open)(pTHX_ PerlIO_funcs *tab, AV *layers, IV n, @@ -125,9 +124,9 @@ same as the public C functions: void (*Set_ptrcnt)(pTHX_ PerlIO *f,STDCHAR *ptr,SSize_t cnt); }; -The first few members of the struct give a function table size for -compatibility check "name" for the layer, the size to C for the per-instance data, -and some flags which are attributes of the class as whole (such as whether it is a buffering +The first few members of the struct give a "name" for the layer, the +size to C for the per-instance data, and some flags which are +attributes of the class as whole (such as whether it is a buffering layer), then follow the functions which fall into four basic groups: =over 4 @@ -324,14 +323,6 @@ to change during one "get".) =over 4 -=item size - - Size_t fsize; - -Size of the function table. This is compared against the value PerlIO code "knows" -as a compatibility check. Future versions I be able to tolerate layers -compiled against an old version of the headers. - =item name char * name; @@ -352,14 +343,6 @@ The size of the per-instance data structure, e.g.: sizeof(PerlIOAPR) -If this field is zero then C does not malloc anything and assumes -layer's Pushed function will do any required layer stack manipulation - used -to avoid malloc/free overhead for dummy layers. -If the field is non-zero it must be at least the size of C, -C will allocate memory for the layer's data structures -and link new layer onto the stream's stack. (If the layer's Pushed -method returns an error indication the layer is popped again.) - =item kind IV kind; @@ -509,18 +492,18 @@ Returns the Unix/Posix numeric file descriptor for the handle. Normally C (which just asks next layer down) will suffice for this. -Returns -1 on error, which is considered to include the case where the layer cannot -provide such a file descriptor. +Returns -1 if the layer cannot provide such a file descriptor, or in +the case of the error. + +XXX: two possible results end up in -1, one is an error the other is +not. =item Dup PerlIO * (*Dup)(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags); -XXX: Needs more docs. - -Used as part of the "clone" process when a thread is spawned (in which case -param will be non-NULL) and when a stream is being duplicated via '&' in the C. +XXX: not documented Similar to C, returns PerlIO* on success, C on failure. diff --git a/win32/win32io.c b/win32/win32io.c index f0f71e7..7997658 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -52,9 +52,9 @@ PerlIOWin32_fileno(pTHX_ PerlIO *f) } IV -PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) +PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { - IV code = PerlIOBase_pushed(aTHX_ f,mode,arg,tab); + IV code = PerlIOBase_pushed(aTHX_ f,mode,arg); if (*PerlIONext(f)) { PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); @@ -341,7 +341,6 @@ PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags) } PerlIO_funcs PerlIO_win32 = { - sizeof(PerlIO_funcs), "win32", sizeof(PerlIOWin32), PERLIO_K_RAW,