From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Fri, 13 Apr 2001 10:14:29 +0000 (+0000)
Subject: Fix core dump on binmode($fh,'Scalar')
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=564dc0571b960461268bbba92def9b6291dae773;p=p5sagit%2Fp5-mst-13.2.git

Fix core dump on binmode($fh,'Scalar')

p4raw-id: //depot/perlio@9696
---

diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs
index 7a01ec6..b4479d5 100644
--- a/ext/PerlIO/Scalar/Scalar.xs
+++ b/ext/PerlIO/Scalar/Scalar.xs
@@ -16,8 +16,30 @@ typedef struct
 IV
 PerlIOScalar_pushed(PerlIO *f, const char *mode, SV *arg)
 {
- PerlIOScalar *b = PerlIOSelf(f,PerlIOScalar);
- return PerlIOBase_pushed(f,mode,arg);
+ dTHX;
+ PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
+ /* If called (normally) via open() then arg is ref to scalar we are
+    using, otherwise arg (from binmode presumably) is either NULL
+    or the _name_ of the scalar
+  */
+ if  (arg)
+  {
+   if (SvROK(arg))
+    {
+     s->var = SvREFCNT_inc(SvRV(arg));
+    }
+   else
+    {
+     s->var = SvREFCNT_inc(perl_get_sv(SvPV_nolen(arg),GV_ADD|GV_ADDMULTI));
+    }
+  }
+ else
+  {
+   s->var = newSVpvn("",0);
+  }
+ sv_upgrade(s->var,SVt_PV);
+ s->posn = 0;
+ return PerlIOBase_pushed(f,mode,Nullsv);
 }
 
 IV
@@ -171,20 +193,13 @@ PerlIO *
 PerlIOScalar_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
 {
  PerlIOScalar *s;
- if (narg > 0)
+ SV *arg = (narg > 0) ? *args : PerlIOArg;
+ if (SvROK(arg) || SvPOK(arg))
   {
-   SV *ref = *args;
-   if (SvROK(ref))
-    {
-     SV *var = SvRV(ref);
-     sv_upgrade(var,SVt_PV);
-     f = PerlIO_allocate(aTHX);
-     s = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,PerlIOArg),PerlIOScalar);
-     s->var = SvREFCNT_inc(var);
-     s->posn = 0;
-     PerlIOBase(f)->flags |= PERLIO_F_OPEN;
-     return f;
-    }
+   f = PerlIO_allocate(aTHX);
+   s = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,arg),PerlIOScalar);
+   PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+   return f;
   }
  return NULL;
 }