diff options
| -rw-r--r-- | doio.c | 112 | ||||
| -rw-r--r-- | perlio.c | 459 | ||||
| -rw-r--r-- | perlio.h | 5 | ||||
| -rw-r--r-- | pp_sys.c | 14 | ||||
| -rwxr-xr-x | t/lib/io_tell.t | 2 | ||||
| -rw-r--r-- | win32/makefile.mk | 6 |
6 files changed, 466 insertions, 132 deletions
@@ -517,7 +517,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } } } - else if (O_BINARY != O_TEXT) { + else if (O_BINARY != O_TEXT && IoTYPE(io) != IoTYPE_STD && !saveifp) { type = ":crlf"; } } @@ -1055,7 +1055,11 @@ fail_discipline: end = strchr(s+1, ':'); if (!end) end = s+len; +#ifndef PERLIO_LAYERS Perl_croak(aTHX_ "Unknown discipline '%.*s'", end-s, s); +#else + s = end; +#endif } } } @@ -1065,46 +1069,11 @@ fail_discipline: int Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode) { -#ifdef DOSISH -# if defined(atarist) || defined(__MINT__) - if (!PerlIO_flush(fp)) { - if (mode & O_BINARY) - ((FILE*)fp)->_flag |= _IOBIN; - else - ((FILE*)fp)->_flag &= ~ _IOBIN; - return 1; - } - return 0; -# else - if (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1) { -# if defined(WIN32) && defined(__BORLANDC__) - /* The translation mode of the stream is maintained independent - * of the translation mode of the fd in the Borland RTL (heavy - * digging through their runtime sources reveal). User has to - * set the mode explicitly for the stream (though they don't - * document this anywhere). GSAR 97-5-24 - */ - PerlIO_seek(fp,0L,0); - if (mode & O_BINARY) - ((FILE*)fp)->flags |= _F_BIN; - else - ((FILE*)fp)->flags &= ~ _F_BIN; -# endif - return 1; - } - else - return 0; -# endif -#else -# if defined(USEMYBINMODE) - if (my_binmode(fp, iotype, mode) != FALSE) - return 1; - else - return 0; -# else - return 1; -# endif -#endif + /* The old body of this is now in non-LAYER part of perlio.c + * This is a stub for any XS code which might have been calling it. + */ + char *name = (O_BINARY != O_TEXT && !(mode & O_BINARY)) ? ":crlf" : ":raw"; + return PerlIO_binmode(aTHX_ fp, iotype, mode, name); } #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) @@ -2078,16 +2047,21 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) ** without checking the ungetc buffer. **/ +/* Not threadsafe? */ static S64_IOB *s64_buffer = (S64_IOB *) NULL; /* initialize the buffer area */ /* required after a fork(2) call in order to remove side effects */ -void Perl_do_s64_init_buffer() { +void +Perl_do_s64_init_buffer(void) +{ s64_buffer = (S64_IOB *) NULL; } /* get a buffered stream pointer */ -static S64_IOB *S_s64_get_buffer(pTHX_ PerlIO *fp) { +STATIC S64_IOB* +S_s64_get_buffer(pTHX_ PerlIO *fp) +{ S64_IOB *ptr = s64_buffer; while( ptr && ptr->fp != fp) ptr = ptr->next; @@ -2095,7 +2069,9 @@ static S64_IOB *S_s64_get_buffer(pTHX_ PerlIO *fp) { } /* create a buffered stream pointer */ -static S64_IOB *S_s64_create_buffer(pTHX_ PerlIO *f) { +STATIC S64_IOB* +S_s64_create_buffer(pTHX_ PerlIO *f) +{ S64_IOB *ptr = malloc( sizeof( S64_IOB)); if( ptr) { ptr->fp = f; @@ -2110,7 +2086,9 @@ static S64_IOB *S_s64_create_buffer(pTHX_ PerlIO *f) { } /* delete a buffered stream pointer */ -void Perl_do_s64_delete_buffer(pTHX_ PerlIO *f) { +void +Perl_do_s64_delete_buffer(pTHX_ PerlIO *f) +{ S64_IOB *ptr = S_s64_get_buffer(aTHX_ f); if( ptr) { /* fix the stream pointer according to the bytes buffered */ @@ -2126,21 +2104,26 @@ void Perl_do_s64_delete_buffer(pTHX_ PerlIO *f) { } /* internal buffer management */ -#define _S64_BUFFER_SIZE 32 -static int S_s64_malloc(pTHX_ S64_IOB *ptr) { + +#define S64_BUFFER_SIZE 32 + +STATIC int +S_s64_malloc(pTHX_ S64_IOB *ptr) +{ if( ptr) { if( !ptr->buffer) { - ptr->buffer = (int *) calloc( _S64_BUFFER_SIZE, sizeof( int)); + ptr->buffer = (int *) calloc( S64_BUFFER_SIZE, sizeof( int)); ptr->size = ptr->cnt = 0; } else { - ptr->buffer = (int *) realloc( ptr->buffer, ptr->size + _S64_BUFFER_SIZE); + ptr->buffer = (int *) realloc( ptr->buffer, + ptr->size + S64_BUFFER_SIZE); } if( !ptr->buffer) return( 0); - ptr->size += _S64_BUFFER_SIZE; - + ptr->size += S64_BUFFER_SIZE; + return( 1); } @@ -2148,22 +2131,26 @@ static int S_s64_malloc(pTHX_ S64_IOB *ptr) { } /* SOCKS 64 bit getc replacement */ -int Perl_do_s64_getc(pTHX_ PerlIO *f) { +int +Perl_do_s64_getc(pTHX_ PerlIO *f) +{ S64_IOB *ptr = S_s64_get_buffer(aTHX_ f); if( ptr) { - if( ptr->cnt) + if( ptr->cnt) return( ptr->buffer[--ptr->cnt]); } return( getc(f)); } /* SOCKS 64 bit ungetc replacement */ -int Perl_do_s64_ungetc(pTHX_ int ch, PerlIO *f) { +int +Perl_do_s64_ungetc(pTHX_ int ch, PerlIO *f) +{ S64_IOB *ptr = S_s64_get_buffer(aTHX_ f); if( !ptr) ptr = S_s64_create_buffer(aTHX_ f); if( !ptr) return( EOF); - if( !ptr->buffer || (ptr->buffer && ptr->cnt >= ptr->size)) + if( !ptr->buffer || (ptr->buffer && ptr->cnt >= ptr->size)) if( !S_s64_malloc(aTHX_ ptr)) return( EOF); ptr->buffer[ptr->cnt++] = ch; @@ -2171,7 +2158,9 @@ int Perl_do_s64_ungetc(pTHX_ int ch, PerlIO *f) { } /* SOCKS 64 bit fread replacement */ -SSize_t Perl_do_s64_fread(pTHX_ void *buf, SSize_t count, PerlIO* f) { +SSize_t +Perl_do_s64_fread(pTHX_ void *buf, SSize_t count, PerlIO* f) +{ SSize_t len = 0; char *bufptr = (char *) buf; S64_IOB *ptr = S_s64_get_buffer(aTHX_ f); @@ -2188,7 +2177,9 @@ SSize_t Perl_do_s64_fread(pTHX_ void *buf, SSize_t count, PerlIO* f) { } /* SOCKS 64 bit fseek replacement */ -int Perl_do_s64_seek(pTHX_ PerlIO* f, Off_t offset, int whence) { +int +Perl_do_s64_seek(pTHX_ PerlIO* f, Off_t offset, int whence) +{ S64_IOB *ptr = S_s64_get_buffer(aTHX_ f); /* Simply clear the buffer and seek if the position is absolute */ @@ -2210,7 +2201,9 @@ int Perl_do_s64_seek(pTHX_ PerlIO* f, Off_t offset, int whence) { } /* SOCKS 64 bit ftell replacement */ -Off_t Perl_do_s64_tell(pTHX_ PerlIO* f) { +Off_t +Perl_do_s64_tell(pTHX_ PerlIO* f) +{ Off_t offset = 0; S64_IOB *ptr = S_s64_get_buffer(aTHX_ f); if( ptr) @@ -2218,4 +2211,5 @@ Off_t Perl_do_s64_tell(pTHX_ PerlIO* f) { return( ftello(f) - offset); } -#endif +#endif /* SOCKS_64BIT_BUG */ + @@ -40,6 +40,56 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) /* NOTREACHED */ return -1; } + +int +PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names) +{ +/* This used to be contents of do_binmode in doio.c */ +#ifdef DOSISH +# if defined(atarist) || defined(__MINT__) + if (!PerlIO_flush(fp)) { + if (mode & O_BINARY) + ((FILE*)fp)->_flag |= _IOBIN; + else + ((FILE*)fp)->_flag &= ~ _IOBIN; + return 1; + } + return 0; +# else + if (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1) { +# if defined(WIN32) && defined(__BORLANDC__) + /* The translation mode of the stream is maintained independent + * of the translation mode of the fd in the Borland RTL (heavy + * digging through their runtime sources reveal). User has to + * set the mode explicitly for the stream (though they don't + * document this anywhere). GSAR 97-5-24 + */ + PerlIO_seek(fp,0L,0); + if (mode & O_BINARY) + ((FILE*)fp)->flags |= _F_BIN; + else + ((FILE*)fp)->flags &= ~ _F_BIN; +# endif + return 1; + } + else + return 0; +# endif +#else +# if defined(USEMYBINMODE) + if (my_binmode(fp, iotype, mode) != FALSE) + return 1; + else + return 0; +# else + return 1; +# endif +#endif +} + + + + #endif #if !defined(PERL_IMPLICIT_SYS) @@ -193,7 +243,7 @@ PerlIO_cleantable(PerlIO **tablep) for (i=PERLIO_TABLE_SIZE-1; i > 0; i--) { PerlIO *f = table+i; - if (*f) + if (*f) { PerlIO_close(f); } @@ -431,6 +481,41 @@ PerlIO_default_layer(I32 n) return tab; } +#define PerlIO_default_top() PerlIO_default_layer(-1) +#define PerlIO_default_btm() PerlIO_default_layer(0) + +void +PerlIO_stdstreams() +{ + if (!_perlio) + { + PerlIO_allocate(); + PerlIO_fdopen(0,"Ir"); + PerlIO_fdopen(1,"Iw"); + PerlIO_fdopen(2,"Iw"); + } +} + +PerlIO * +PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode) +{ + PerlIOl *l = NULL; + Newc('L',l,tab->size,char,PerlIOl); + if (l) + { + Zero(l,tab->size,char); + l->next = *f; + l->tab = tab; + *f = l; + if ((*l->tab->Pushed)(f,mode) != 0) + { + PerlIO_pop(f); + return NULL; + } + } + return f; +} + int PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) { @@ -450,19 +535,34 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) e++; if (e > s) { - SV *layer = PerlIO_find_layer(s,e-s); - if (layer) + if ((e - s) == 3 && strncmp(s,"raw",3) == 0) { - PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer))); - if (tab) + /* Pop back to bottom layer */ + if (PerlIONext(f)) { - PerlIO *new = PerlIO_push(f,tab,mode); - if (!new) - return -1; + PerlIO_flush(f); + while (PerlIONext(f)) + { + PerlIO_pop(f); + } } } else - Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(e-s),s); + { + SV *layer = PerlIO_find_layer(s,e-s); + if (layer) + { + PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer))); + if (tab) + { + PerlIO *new = PerlIO_push(f,tab,mode); + if (!new) + return -1; + } + } + else + Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(int)(e-s),s); + } } s = e; } @@ -471,44 +571,32 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) return 0; } -#define PerlIO_default_top() PerlIO_default_layer(-1) -#define PerlIO_default_btm() PerlIO_default_layer(0) -void -PerlIO_stdstreams() -{ - if (!_perlio) - { - PerlIO_allocate(); - PerlIO_fdopen(0,"Ir"); - PerlIO_fdopen(1,"Iw"); - PerlIO_fdopen(2,"Iw"); - } -} -PerlIO * -PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode) +/*--------------------------------------------------------------------------------------*/ +/* Given the abstraction above the public API functions */ + +int +PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names) { - PerlIOl *l = NULL; - Newc('L',l,tab->size,char,PerlIOl); - if (l) + if (!names || (O_TEXT != O_BINARY && mode & O_BINARY)) { - Zero(l,tab->size,char); - l->next = *f; - l->tab = tab; - *f = l; - if ((*l->tab->Pushed)(f,mode) != 0) + PerlIO *top = fp; + PerlIOl *l; + while (l = *top) { - PerlIO_pop(f); - return NULL; + if (PerlIOBase(top)->tab == &PerlIO_crlf) + { + PerlIO_flush(top); + PerlIO_pop(top); + break; + } + top = PerlIONext(top); } } - return f; + return PerlIO_apply_layers(aTHX_ fp, NULL, names) == 0 ? TRUE : FALSE; } -/*--------------------------------------------------------------------------------------*/ -/* Given the abstraction above the public API functions */ - #undef PerlIO_close int PerlIO_close(PerlIO *f) @@ -948,8 +1036,10 @@ PerlIOUnix_oflags(const char *mode) if (*mode == 'b') { oflags |= O_BINARY; - mode++; - } + mode++; + } + /* Always open in binary mode */ + oflags |= O_BINARY; if (*mode || oflags == -1) { errno = EINVAL; @@ -1659,35 +1749,33 @@ PerlIOBuf_fill(PerlIO *f) SSize_t PerlIOBuf_read(PerlIO *f, void *vbuf, Size_t count) { - PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); - STDCHAR *buf = (STDCHAR *) vbuf; + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + STDCHAR *buf = (STDCHAR *) vbuf; if (f) { - Size_t got = 0; if (!b->ptr) PerlIO_get_base(f); if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) return 0; while (count > 0) { - SSize_t avail = (b->end - b->ptr); - if ((SSize_t) count < avail) - avail = count; - if (avail > 0) + SSize_t avail = PerlIO_get_cnt(f); + SSize_t take = (count < avail) ? count : avail; + if (take > 0) { - Copy(b->ptr,buf,avail,STDCHAR); - got += avail; - b->ptr += avail; - count -= avail; - buf += avail; + 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 && (b->ptr >= b->end)) + if (count > 0 && avail <= 0) { if (PerlIO_fill(f) != 0) break; } } - return got; + return (buf - (STDCHAR *) vbuf); } return 0; } @@ -1929,27 +2017,269 @@ PerlIO_funcs PerlIO_perlio = { }; /*--------------------------------------------------------------------------------------*/ -/* crlf - translation currently just a copy of perlio to prove - that extra buffering which real one will do is not an issue. +/* crlf - translation + On read translate CR,LF to "\n" we do this by overriding ptr/cnt entries + to hand back a line at a time and keeping a record of which nl we "lied" about. + On write translate "\n" to CR,LF */ +typedef struct +{ + PerlIOBuf base; /* PerlIOBuf stuff */ + STDCHAR *nl; /* Position of crlf we "lied" about in the buffer */ +} PerlIOCrlf; + +SSize_t +PerlIOCrlf_unread(PerlIO *f, const void *vbuf, Size_t count) +{ + const STDCHAR *buf = (const STDCHAR *) vbuf+count; + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + PerlIOCrlf *c = PerlIOSelf(f,PerlIOCrlf); + SSize_t unread = 0; + if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) + PerlIO_flush(f); + if (c->nl) + { + *(c->nl) = 0xd; + c->nl = NULL; + } + if (!b->buf) + PerlIO_get_base(f); + if (b->buf) + { + if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) + { + b->end = b->ptr = b->buf + b->bufsiz; + PerlIOBase(f)->flags |= PERLIO_F_RDBUF; + } + while (count > 0 && b->ptr > b->buf) + { + int ch = *--buf; + if (ch == '\n') + { + if (b->ptr - 2 >= b->buf) + { + *--(b->ptr) = 0xa; + *--(b->ptr) = 0xd; + unread++; + count--; + } + else + { + buf++; + break; + } + } + else + { + *--(b->ptr) = ch; + unread++; + count--; + } + } + } + return unread; +} + +SSize_t +PerlIOCrlf_get_cnt(PerlIO *f) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + if (!b->buf) + PerlIO_get_base(f); + if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) + { + PerlIOCrlf *c = PerlIOSelf(f,PerlIOCrlf); + if (!c->nl) + { + STDCHAR *nl = b->ptr; + scan: + while (nl < b->end && *nl != 0xd) + nl++; + if (nl < b->end && *nl == 0xd) + { + test: + if (nl+1 < b->end) + { + if (nl[1] == 0xa) + { + *nl = '\n'; + c->nl = nl; + } + else + { + /* Not CR,LF but just CR */ + nl++; + goto scan; + } + } + else + { + /* Blast - found CR as last char in buffer */ + if (b->ptr < nl) + { + /* They may not care, defer work as long as possible */ + return (nl - b->ptr); + } + else + { + int code; + dTHX; + b->ptr++; /* say we have read it as far as flush() is concerned */ + b->buf++; /* Leave space an front of buffer */ + b->bufsiz--; /* Buffer is thus smaller */ + code = PerlIO_fill(f); /* Fetch some more */ + b->bufsiz++; /* Restore size for next time */ + b->buf--; /* Point at space */ + b->ptr = nl = b->buf; /* Which is what we hand off */ + b->posn--; /* Buffer starts here */ + *nl = 0xd; /* Fill in the CR */ + if (code == 0) + goto test; /* fill() call worked */ + /* CR at EOF - just fall through */ + } + } + } + } + return (((c->nl) ? (c->nl+1) : b->end) - b->ptr); + } + return 0; +} + +void +PerlIOCrlf_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + PerlIOCrlf *c = PerlIOSelf(f,PerlIOCrlf); + if (!b->buf) + PerlIO_get_base(f); + if (!ptr) + { + if (c->nl) + ptr = c->nl+1; + else + { + ptr = b->end; + if (ptr > b->buf && ptr[-1] == 0xd) + ptr--; + } + ptr -= cnt; + } + else + { + /* Test code - delete when it works ... */ + STDCHAR *chk; + if (c->nl) + chk = c->nl+1; + else + { + chk = b->end; + if (chk > b->buf && chk[-1] == 0xd) + chk--; + } + chk -= cnt; + + if (ptr != chk) + { + dTHX; + Perl_croak(aTHX_ "ptr wrong %p != %p nl=%p e=%p for %d", + ptr, chk, c->nl, b->end, cnt); + } + } + if (c->nl) + { + if (ptr > c->nl) + { + /* They have taken what we lied about */ + *(c->nl) = 0xd; + c->nl = NULL; + ptr++; + } + } + b->ptr = ptr; + PerlIOBase(f)->flags |= PERLIO_F_RDBUF; +} + +SSize_t +PerlIOCrlf_write(PerlIO *f, const void *vbuf, Size_t count) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + const STDCHAR *buf = (const STDCHAR *) vbuf; + const STDCHAR *ebuf = buf+count; + if (!b->buf) + PerlIO_get_base(f); + if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) + return 0; + while (buf < ebuf) + { + STDCHAR *eptr = b->buf+b->bufsiz; + PerlIOBase(f)->flags |= PERLIO_F_WRBUF; + while (buf < ebuf && b->ptr < eptr) + { + if (*buf == '\n') + { + if ((b->ptr + 2) > eptr) + { + /* Not room for both */ + PerlIO_flush(f); + break; + } + else + { + *(b->ptr)++ = 0xd; /* CR */ + *(b->ptr)++ = 0xa; /* LF */ + buf++; + if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF) + { + PerlIO_flush(f); + break; + } + } + } + else + { + int ch = *buf++; + *(b->ptr)++ = ch; + } + if (b->ptr >= eptr) + { + PerlIO_flush(f); + break; + } + } + } + return (buf - (STDCHAR *) vbuf); +} + +IV +PerlIOCrlf_flush(PerlIO *f) +{ + PerlIOCrlf *c = PerlIOSelf(f,PerlIOCrlf); + if (c->nl) + { + *(c->nl) = 0xd; + c->nl = NULL; + } + return PerlIOBuf_flush(f); +} + PerlIO_funcs PerlIO_crlf = { "crlf", - sizeof(PerlIOBuf), + sizeof(PerlIOCrlf), 0, PerlIOBase_fileno, PerlIOBuf_fdopen, PerlIOBuf_open, PerlIOBuf_reopen, PerlIOBase_pushed, - PerlIOBase_noop_ok, - PerlIOBuf_read, - PerlIOBuf_unread, - PerlIOBuf_write, + PerlIOBase_noop_ok, /* popped */ + PerlIOBuf_read, /* generic read works with ptr/cnt lies ... */ + PerlIOCrlf_unread, /* Put CR,LF in buffer for each '\n' */ + PerlIOCrlf_write, /* Put CR,LF in buffer for each '\n' */ PerlIOBuf_seek, PerlIOBuf_tell, PerlIOBuf_close, - PerlIOBuf_flush, + PerlIOCrlf_flush, PerlIOBuf_fill, PerlIOBase_eof, PerlIOBase_error, @@ -1958,8 +2288,8 @@ PerlIO_funcs PerlIO_crlf = { PerlIOBuf_get_base, PerlIOBuf_bufsiz, PerlIOBuf_get_ptr, - PerlIOBuf_get_cnt, - PerlIOBuf_set_ptrcnt, + PerlIOCrlf_get_cnt, + PerlIOCrlf_set_ptrcnt, }; #ifdef HAS_MMAP @@ -1972,7 +2302,6 @@ typedef struct Mmap_t mptr; /* Mapped address */ Size_t len; /* mapped length */ STDCHAR *bbuf; /* malloced buffer if map fails */ - } PerlIOMmap; static size_t page_size = 0; @@ -309,7 +309,10 @@ extern PerlIO * PerlIO_fdupopen (PerlIO *); extern int PerlIO_isutf8 (PerlIO *); #endif #ifndef PerlIO_apply_layers -extern int PerlIO_apply_layers (pTHX_ PerlIO *f,const char *mode, const char *names); +extern int PerlIO_apply_layers (pTHX_ PerlIO *f, const char *mode, const char *names); +#endif +#ifndef PerlIO_binmode +extern int PerlIO_binmode (pTHX_ PerlIO *f, int iotype, int omode, const char *names); #endif extern void PerlIO_debug(const char *fmt,...); @@ -687,11 +687,14 @@ PP(pp_binmode) PerlIO *fp; MAGIC *mg; SV *discp = Nullsv; + STRLEN len = 0; + char *names = NULL; if (MAXARG < 1) RETPUSHUNDEF; - if (MAXARG > 1) + if (MAXARG > 1) { discp = POPs; + } gv = (GV*)POPs; @@ -712,7 +715,12 @@ PP(pp_binmode) if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) RETPUSHUNDEF; - if (do_binmode(fp,IoTYPE(io),mode_from_discipline(discp))) + if (discp) { + names = SvPV(discp,len); + } + + if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp), + (discp) ? SvPV_nolen(discp) : Nullch)) RETPUSHYES; else RETPUSHUNDEF; @@ -3137,7 +3145,7 @@ PP(pp_fttext) (void)PerlIO_close(fp); RETPUSHUNDEF; } - do_binmode(fp, '<', O_BINARY); + PerlIO_binmode(aTHX_ fp, '<', O_BINARY, Nullch); len = PerlIO_read(fp, tbuf, sizeof(tbuf)); (void)PerlIO_close(fp); if (len <= 0) { diff --git a/t/lib/io_tell.t b/t/lib/io_tell.t index 3aa4b031e1..65c63bdfc9 100755 --- a/t/lib/io_tell.t +++ b/t/lib/io_tell.t @@ -27,7 +27,7 @@ print "1..13\n"; use IO::File; $tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file"); -binmode $tst if ($^O eq 'MSWin32' or $^O eq 'dos'); +binmode $tst; # its a nop unless it matters. Was only if ($^O eq 'MSWin32' or $^O eq 'dos'); if ($tst->eof) { print "not ok 1\n"; } else { print "ok 1\n"; } $firstline = <$tst>; diff --git a/win32/makefile.mk b/win32/makefile.mk index 4677c809ed..681e28f401 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -371,7 +371,7 @@ a = .a # Options # -INCLUDES = -I$(COREDIR) -I.\include -I. -I.. +INCLUDES = -I.\include -I. -I.. -I$(COREDIR) DEFINES = -DWIN32 $(CRYPT_FLAG) LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console @@ -387,11 +387,11 @@ LIBFILES = $(CRYPT_LIB) $(LIBC) \ -lwinmm -lversion -lodbc32 .IF "$(CFG)" == "Debug" -OPTIMIZE = -g -DDEBUGGING +OPTIMIZE = -g -O2 -DDEBUGGING LINK_DBG = -g .ELSE OPTIMIZE = -g -O2 -LINK_DBG = +LINK_DBG = -g .ENDIF CFLAGS = $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE) |