diff options
| -rw-r--r-- | ext/Encode/Encode.pm | 6 | ||||
| -rw-r--r-- | ext/Encode/Encode.xs | 11 | ||||
| -rw-r--r-- | ext/PerlIO/Scalar/Scalar.xs | 1 | ||||
| -rw-r--r-- | perl.c | 8 | ||||
| -rw-r--r-- | perlio.c | 58 | ||||
| -rw-r--r-- | perlio.h | 2 | ||||
| -rw-r--r-- | perliol.h | 1 | ||||
| -rw-r--r-- | pp_hot.c | 3 | ||||
| -rw-r--r-- | win32/makefile.mk | 4 |
9 files changed, 69 insertions, 25 deletions
diff --git a/ext/Encode/Encode.pm b/ext/Encode/Encode.pm index fd85520311..650180647b 100644 --- a/ext/Encode/Encode.pm +++ b/ext/Encode/Encode.pm @@ -273,7 +273,7 @@ use base 'Encode::Encoding'; # Encoding is 16-bit network order Unicode (no surogates) # Used for X font encodings -__PACKAGE__->Define(qw(UCS-2 iso10646-1)); +__PACKAGE__->Define(qw(UCS-2 iso-10646-1)); sub decode { @@ -285,7 +285,7 @@ sub decode $uni .= chr($code); } $_[1] = $str if $chk; - Encode::utf8_upgrade($uni); + utf8::upgrade($uni); return $uni; } @@ -586,7 +586,7 @@ UTF-16 is similar to UCS-2, 16 bit or 2-byte chunks. UCS-2 can only represent 0..0xFFFF, while UTF-16 has a "surogate pair" scheme which allows it to cover the whole Unicode range. -Encode implements big-endian UCS-2 aliased to "iso10646-1" as that +Encode implements big-endian UCS-2 aliased to "iso-10646-1" as that happens to be the name used by that representation when used with X11 fonts. UTF-32 or UCS-4 is 32-bit or 4-byte chunks. Perl's logical characters diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs index 74303c9389..13ba7045c4 100644 --- a/ext/Encode/Encode.xs +++ b/ext/Encode/Encode.xs @@ -219,9 +219,11 @@ PerlIOEncode_flush(PerlIO *f) { PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode); IV code = 0; - dTHX; - if (e->bufsv && (PerlIOBase(f)->flags & (PERLIO_F_RDBUF|PERLIO_F_WRBUF))) + if (e->bufsv && (PerlIOBase(f)->flags & (PERLIO_F_RDBUF|PERLIO_F_WRBUF)) + &&(e->base.ptr > e->base.buf) + ) { + dTHX; dSP; SV *str; char *s; @@ -452,6 +454,11 @@ encode_method(pTHX_ encode_t *enc, encpage_t *dir, SV *src, int check) SvCUR_set(src,SvCUR(src)-slen); } } + else + { + SvCUR_set(dst,slen); + SvPOK_on(dst); + } return dst; } diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs index 650cc5a67a..7a01ec696c 100644 --- a/ext/PerlIO/Scalar/Scalar.xs +++ b/ext/PerlIO/Scalar/Scalar.xs @@ -124,6 +124,7 @@ PerlIOScalar_get_base(PerlIO *f) dTHX; return (STDCHAR *)SvPV_nolen(s->var); } + return (STDCHAR *) Nullch; } STDCHAR * @@ -395,6 +395,7 @@ perl_destruct(pTHXx) LEAVE; FREETMPS; + /* We must account for everything. */ /* Destroy the main CV and syntax tree */ @@ -409,6 +410,13 @@ perl_destruct(pTHXx) PL_main_cv = Nullcv; PL_dirty = TRUE; + /* Tell PerlIO we are about to tear things apart in case + we have layers which are using resources that should + be cleaned up now. + */ + + PerlIO_destruct(aTHX); + if (PL_sv_objcount) { /* * Try to destruct global references. We do this first so that the @@ -93,6 +93,11 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) return -1; } +void +PerlIO_destruct(pTHX) +{ +} + int PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names) { @@ -313,6 +318,37 @@ PerlIO_cleanup() } void +PerlIO_destruct(pTHX) +{ + PerlIO **table = &_perlio; + PerlIO *f; + while ((f = *table)) + { + int i; + table = (PerlIO **)(f++); + for (i=1; i < PERLIO_TABLE_SIZE; i++) + { + PerlIO *x = f; + PerlIOl *l; + while ((l = *x)) + { + if (l->tab->kind & PERLIO_K_DESTRUCT) + { + PerlIO_debug("Destruct popping %s\n",l->tab->name); + PerlIO_flush(x); + PerlIO_pop(aTHX_ x); + } + else + { + x = PerlIONext(x); + } + } + f++; + } + } +} + +void PerlIO_pop(pTHX_ PerlIO *f) { PerlIOl *l = *f; @@ -888,11 +924,11 @@ PerlIO_resolve_layers(pTHX_ const char *layers,const char *mode,int narg, SV **a PerlIO_stdstreams(aTHX); if (narg) { - if (SvROK(*args)) + if (SvROK(*args) && !sv_isobject(*args)) { - if (sv_isobject(*args)) + if (SvTYPE(SvRV(*args)) < SVt_PVAV) { - SV *handler = PerlIO_find_layer(aTHX_ "object",6); + SV *handler = PerlIO_find_layer(aTHX_ "Scalar",6); if (handler) { def = newAV(); @@ -903,21 +939,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers,const char *mode,int narg, SV **a } 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()"); - } + Perl_croak(aTHX_ "Unsupported reference arg to open()"); } } } @@ -327,6 +327,8 @@ extern int PerlIO_apply_layers (pTHX_ PerlIO *f, const char *mode, const char *n extern int PerlIO_binmode (pTHX_ PerlIO *f, int iotype, int omode, const char *names); #endif +extern void PerlIO_destruct(pTHX); + #ifndef PERLIO_IS_STDIO extern void PerlIO_cleanup(void); @@ -46,6 +46,7 @@ struct _PerlIO_funcs #define PERLIO_K_FASTGETS 0x00000008 #define PERLIO_K_DUMMY 0x00000010 #define PERLIO_K_UTF8 0x00008000 +#define PERLIO_K_DESTRUCT 0x00010000 /*--------------------------------------------------------------------------------------*/ struct _PerlIO @@ -1511,6 +1511,7 @@ Perl_do_readline(pTHX) || (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs)) for (;;) { + PUTBACK; if (!sv_gets(sv, fp, offset) && (type == OP_GLOB || SNARF_EOF(gimme, PL_rs, io, sv))) { @@ -1531,6 +1532,7 @@ Perl_do_readline(pTHX) } if (gimme == G_SCALAR) { (void)SvOK_off(TARG); + SPAGAIN; PUSHTARG; } MAYBE_TAINT_LINE(io, sv); @@ -1540,6 +1542,7 @@ Perl_do_readline(pTHX) IoLINES(io)++; IoFLAGS(io) |= IOf_NOLINE; SvSETMAGIC(sv); + SPAGAIN; XPUSHs(sv); if (type == OP_GLOB) { char *tmps; diff --git a/win32/makefile.mk b/win32/makefile.mk index f365bcff12..4b369ed11a 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -1254,9 +1254,9 @@ $(MD5_DLL): $(PERLDEP) $(MD5).xs cd $(EXTDIR)\Digest\MD5 && $(MAKE) $(MIMEBASE64_DLL): $(PERLDEP) $(MIMEBASE64).xs - cd $(EXTDIR)\Digest\Mime\Base64 && \ + cd $(EXTDIR)\MIME\Base64 && \ ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl - cd $(EXTDIR)\Digest\MIMEBASE64 && $(MAKE) + cd $(EXTDIR)\MIME\Base64 && $(MAKE) $(ERRNO_PM): $(PERLDEP) $(ERRNO)_pm.PL cd $(EXTDIR)\$(*B) && \ |