Fix :scalar layer to allow it to exist under other layers.

Actual fix is just the if (!f) test before calling
PerlIO_allocate(). Rest of change is conforming to
standard indent.

p4raw-id: //depot/perlio@17587

1 files changed, 196 insertions, 206 deletions

diff --git a/ext/PerlIO/scalar/scalar.xs b/ext/PerlIO/scalar/scalar.xs
index f505c89f5d..c027bd12d1 100644
--- a/ext/PerlIO/scalar/scalar.xs
+++ b/ext/PerlIO/scalar/scalar.xs
@@ -6,291 +6,281 @@
 
 #include "perliol.h"
 
-typedef struct
-{
- struct _PerlIO base;       /* Base "class" info */
- SV *		var;
- Off_t		posn;
+typedef struct {
+    struct _PerlIO base;	/* Base "class" info */
+    SV *var;
+    Off_t posn;
 } PerlIOScalar;
 
 IV
-PerlIOScalar_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
+		    PerlIO_funcs * tab)
 {
- IV code;
- 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));
+    IV code;
+    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 = SvREFCNT_inc(perl_get_sv(SvPV_nolen(arg),GV_ADD|GV_ADDMULTI));
+    else {
+	s->var = newSVpvn("", 0);
     }
-  }
- else
-  {
-   s->var = newSVpvn("",0);
-  }
- sv_upgrade(s->var,SVt_PV);
- code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv,tab);
- if ((PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
-   SvCUR(s->var) = 0;
- if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
-   s->posn = SvCUR(s->var);
- else
-   s->posn = 0;
- return code;
+    sv_upgrade(s->var, SVt_PV);
+    code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
+    if ((PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
+	SvCUR(s->var) = 0;
+    if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
+	s->posn = SvCUR(s->var);
+    else
+	s->posn = 0;
+    return code;
 }
 
 IV
-PerlIOScalar_popped(pTHX_ PerlIO *f)
+PerlIOScalar_popped(pTHX_ PerlIO * f)
 {
- PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
- if (s->var)
-  {
-   SvREFCNT_dec(s->var);
-   s->var = Nullsv;
-  }
- return 0;
+    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+    if (s->var) {
+	SvREFCNT_dec(s->var);
+	s->var = Nullsv;
+    }
+    return 0;
 }
 
 IV
-PerlIOScalar_close(pTHX_ PerlIO *f)
+PerlIOScalar_close(pTHX_ PerlIO * f)
 {
- IV code = PerlIOBase_close(aTHX_ f);
- PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
- return code;
+    IV code = PerlIOBase_close(aTHX_ f);
+    PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
+    return code;
 }
 
 IV
-PerlIOScalar_fileno(pTHX_ PerlIO *f)
+PerlIOScalar_fileno(pTHX_ PerlIO * f)
 {
- return -1;
+    return -1;
 }
 
 IV
-PerlIOScalar_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
+PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
 {
- PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
- switch(whence)
-  {
-   case 0:
-    s->posn = offset;
-    break;
-   case 1:
-    s->posn = offset + s->posn;
-    break;
-   case 2:
-    s->posn = offset + SvCUR(s->var);
-    break;
-  }
- if ((STRLEN)s->posn > SvCUR(s->var))
-  {
-   (void) SvGROW(s->var,(STRLEN)s->posn);
-  }
- return 0;
+    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+    switch (whence) {
+    case 0:
+	s->posn = offset;
+	break;
+    case 1:
+	s->posn = offset + s->posn;
+	break;
+    case 2:
+	s->posn = offset + SvCUR(s->var);
+	break;
+    }
+    if ((STRLEN) s->posn > SvCUR(s->var)) {
+	(void) SvGROW(s->var, (STRLEN) s->posn);
+    }
+    return 0;
 }
 
 Off_t
-PerlIOScalar_tell(pTHX_ PerlIO *f)
+PerlIOScalar_tell(pTHX_ PerlIO * f)
 {
- PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
- return s->posn;
+    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+    return s->posn;
 }
 
 SSize_t
-PerlIOScalar_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
+PerlIOScalar_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
 {
- PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
- char *dst = SvGROW(s->var,s->posn+count);
- Move(vbuf,dst+s->posn,count,char);
- s->posn += count;
- SvCUR_set(s->var,s->posn);
- SvPOK_on(s->var);
- return count;
+    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+    char *dst = SvGROW(s->var, s->posn + count);
+    Move(vbuf, dst + s->posn, count, char);
+    s->posn += count;
+    SvCUR_set(s->var, s->posn);
+    SvPOK_on(s->var);
+    return count;
 }
 
 SSize_t
-PerlIOScalar_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
+PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
 {
- if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
-  {
-   Off_t offset;
-   PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
-   SV *sv = s->var;
-   char *dst;
-   if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
-    {
-     dst = SvGROW(sv,SvCUR(sv)+count);
-     offset = SvCUR(sv);
-     s->posn = offset+count;
-    }
-   else
-    {
-     if ((s->posn+count) > SvCUR(sv))
-      dst = SvGROW(sv,s->posn+count);
-     else
-      dst = SvPV_nolen(sv);
-     offset = s->posn;
-     s->posn += count;
+    if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
+	Off_t offset;
+	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+	SV *sv = s->var;
+	char *dst;
+	if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) {
+	    dst = SvGROW(sv, SvCUR(sv) + count);
+	    offset = SvCUR(sv);
+	    s->posn = offset + count;
+	}
+	else {
+	    if ((s->posn + count) > SvCUR(sv))
+		dst = SvGROW(sv, s->posn + count);
+	    else
+		dst = SvPV_nolen(sv);
+	    offset = s->posn;
+	    s->posn += count;
+	}
+	Move(vbuf, dst + offset, count, char);
+	if ((STRLEN) s->posn > SvCUR(sv))
+	    SvCUR_set(sv, s->posn);
+	SvPOK_on(s->var);
+	return count;
     }
-   Move(vbuf,dst+offset,count,char);
-   if ((STRLEN)s->posn > SvCUR(sv))
-    SvCUR_set(sv,s->posn);
-   SvPOK_on(s->var);
-   return count;
-  }
- else
-  return 0;
+    else
+	return 0;
 }
 
 IV
-PerlIOScalar_fill(pTHX_ PerlIO *f)
+PerlIOScalar_fill(pTHX_ PerlIO * f)
 {
- return -1;
+    return -1;
 }
 
 IV
-PerlIOScalar_flush(pTHX_ PerlIO *f)
+PerlIOScalar_flush(pTHX_ PerlIO * f)
 {
- return 0;
+    return 0;
 }
 
 STDCHAR *
-PerlIOScalar_get_base(pTHX_ PerlIO *f)
+PerlIOScalar_get_base(pTHX_ PerlIO * f)
 {
- PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
- if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
-  {
-   return (STDCHAR *)SvPV_nolen(s->var);
-  }
- return (STDCHAR *) Nullch;
+    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+	return (STDCHAR *) SvPV_nolen(s->var);
+    }
+    return (STDCHAR *) Nullch;
 }
 
 STDCHAR *
-PerlIOScalar_get_ptr(pTHX_ PerlIO *f)
+PerlIOScalar_get_ptr(pTHX_ PerlIO * f)
 {
- if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
-  {
-   PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
-   return PerlIOScalar_get_base(aTHX_ f)+s->posn;
-  }
- return (STDCHAR *) Nullch;
+    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+	return PerlIOScalar_get_base(aTHX_ f) + s->posn;
+    }
+    return (STDCHAR *) Nullch;
 }
 
 SSize_t
-PerlIOScalar_get_cnt(pTHX_ PerlIO *f)
+PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
 {
- if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
-  {
-   PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
-   if (SvCUR(s->var) > (STRLEN)s->posn)
-    return SvCUR(s->var) - s->posn;
-   else
+    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+	if (SvCUR(s->var) > (STRLEN) s->posn)
+	    return SvCUR(s->var) - s->posn;
+	else
+	    return 0;
+    }
     return 0;
-  }
- return 0;
 }
 
 Size_t
-PerlIOScalar_bufsiz(pTHX_ PerlIO *f)
+PerlIOScalar_bufsiz(pTHX_ PerlIO * f)
 {
- if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
-  {
-   PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
-   return SvCUR(s->var);
-  }
- return 0;
+    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+	return SvCUR(s->var);
+    }
+    return 0;
 }
 
 void
-PerlIOScalar_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR *ptr, SSize_t cnt)
+PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
 {
- PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
- s->posn = SvCUR(s->var)-cnt;
+    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+    s->posn = SvCUR(s->var) - cnt;
 }
 
 PerlIO *
-PerlIOScalar_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
+PerlIOScalar_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers, IV n,
+		  const char *mode, int fd, int imode, int perm,
+		  PerlIO * f, int narg, SV ** args)
 {
- SV *arg = (narg > 0) ? *args : PerlIOArg;
- if (SvROK(arg) || SvPOK(arg))
-  {
-   f = PerlIO_allocate(aTHX);
-   (void)PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,arg),PerlIOScalar);
-   PerlIOBase(f)->flags |= PERLIO_F_OPEN;
-   return f;
-  }
- return NULL;
+    SV *arg = (narg > 0) ? *args : PerlIOArg;
+    if (SvROK(arg) || SvPOK(arg)) {
+	if (!f) {
+	    f = PerlIO_allocate(aTHX);
+	}
+	if (f = PerlIO_push(aTHX_ f, self, mode, arg)) {
+	    PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+	}
+	return f;
+    }
+    return NULL;
 }
 
 SV *
-PerlIOScalar_arg(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
+PerlIOScalar_arg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
 {
- PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
- SV *var = s->var;
- if (flags & PERLIO_DUP_CLONE)
-  var = PerlIO_sv_dup(aTHX_ var, param);
- else if (flags & PERLIO_DUP_FD)
-  {
-   /* Equivalent (guesses NI-S) of dup() is to create a new scalar */
-   var = newSVsv(var);
-  }
- else
-  {
-   var = SvREFCNT_inc(var);
-  }
- return newRV_noinc(var);
+    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+    SV *var = s->var;
+    if (flags & PERLIO_DUP_CLONE)
+	var = PerlIO_sv_dup(aTHX_ var, param);
+    else if (flags & PERLIO_DUP_FD) {
+	/* Equivalent (guesses NI-S) of dup() is to create a new scalar */
+	var = newSVsv(var);
+    }
+    else {
+	var = SvREFCNT_inc(var);
+    }
+    return newRV_noinc(var);
 }
 
 PerlIO *
-PerlIOScalar_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
+PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
+		 int flags)
 {
- if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags)))
-  {
-   PerlIOScalar *fs = PerlIOSelf(f,PerlIOScalar);
-   PerlIOScalar *os = PerlIOSelf(o,PerlIOScalar);
-   /* var has been set by implicit push */
-   fs->posn = os->posn;
-  }
- return f;
+    if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
+	PerlIOScalar *fs = PerlIOSelf(f, PerlIOScalar);
+	PerlIOScalar *os = PerlIOSelf(o, PerlIOScalar);
+	/* var has been set by implicit push */
+	fs->posn = os->posn;
+    }
+    return f;
 }
 
 PerlIO_funcs PerlIO_scalar = {
- sizeof(PerlIO_funcs),
- "scalar",
- sizeof(PerlIOScalar),
- PERLIO_K_BUFFERED|PERLIO_K_RAW,
- PerlIOScalar_pushed,
- PerlIOScalar_popped,
- PerlIOScalar_open,
- PerlIOBase_binmode,
- PerlIOScalar_arg,
- PerlIOScalar_fileno,
- PerlIOScalar_dup,
- PerlIOBase_read,
- PerlIOScalar_unread,
- PerlIOScalar_write,
- PerlIOScalar_seek,
- PerlIOScalar_tell,
- PerlIOScalar_close,
- PerlIOScalar_flush,
- PerlIOScalar_fill,
- PerlIOBase_eof,
- PerlIOBase_error,
- PerlIOBase_clearerr,
- PerlIOBase_setlinebuf,
- PerlIOScalar_get_base,
- PerlIOScalar_bufsiz,
- PerlIOScalar_get_ptr,
- PerlIOScalar_get_cnt,
- PerlIOScalar_set_ptrcnt,
+    sizeof(PerlIO_funcs),
+    "scalar",
+    sizeof(PerlIOScalar),
+    PERLIO_K_BUFFERED | PERLIO_K_RAW,
+    PerlIOScalar_pushed,
+    PerlIOScalar_popped,
+    PerlIOScalar_open,
+    PerlIOBase_binmode,
+    PerlIOScalar_arg,
+    PerlIOScalar_fileno,
+    PerlIOScalar_dup,
+    PerlIOBase_read,
+    PerlIOScalar_unread,
+    PerlIOScalar_write,
+    PerlIOScalar_seek,
+    PerlIOScalar_tell,
+    PerlIOScalar_close,
+    PerlIOScalar_flush,
+    PerlIOScalar_fill,
+    PerlIOBase_eof,
+    PerlIOBase_error,
+    PerlIOBase_clearerr,
+    PerlIOBase_setlinebuf,
+    PerlIOScalar_get_base,
+    PerlIOScalar_bufsiz,
+    PerlIOScalar_get_ptr,
+    PerlIOScalar_get_cnt,
+    PerlIOScalar_set_ptrcnt,
 };