Add destruct time hook to PerlIO (for work-in-process implementing

layers in perl code. In such cases layers need to be popped before
we loose the ability to run perl code.)
Also back-out "PerlIO::object" hook - it isn't going to work like that...

p4raw-id: //depot/perlio@9346

1 files changed, 40 insertions, 18 deletions

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()");
       }
     }
   }