summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--perl.c8
-rw-r--r--perlio.c58
-rw-r--r--perlio.h2
-rw-r--r--perliol.h1
4 files changed, 51 insertions, 18 deletions
diff --git a/perl.c b/perl.c
index b3637fcd22..41ffdaaf90 100644
--- a/perl.c
+++ b/perl.c
@@ -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
diff --git a/perlio.c b/perlio.c
index 94b7c17fcd..d33c0cb708 100644
--- a/perlio.c
+++ b/perlio.c
@@ -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()");
}
}
}
diff --git a/perlio.h b/perlio.h
index ce28c8da5a..cd722a1018 100644
--- a/perlio.h
+++ b/perlio.h
@@ -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);
diff --git a/perliol.h b/perliol.h
index 449ea89983..d4604e2342 100644
--- a/perliol.h
+++ b/perliol.h
@@ -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