diff options
-rw-r--r-- | perl.c | 8 | ||||
-rw-r--r-- | perlio.c | 58 | ||||
-rw-r--r-- | perlio.h | 2 | ||||
-rw-r--r-- | perliol.h | 1 |
4 files changed, 51 insertions, 18 deletions
@@ -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 |