From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Sat, 24 Mar 2001 14:31:49 +0000 (+0000)
Subject: PerlIO fixups for Win32:
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8c0134a884f927d58f584b87281e5a27133cbf8f;p=p5sagit%2Fp5-mst-13.2.git

PerlIO fixups for Win32:
 - provide win33_popenlist() - non-functional as yet.
 - avoid need for aTHX in PerlIO_debug calls - even if not
   enabled args are still evaluated so Win32 has trouble during fork().
 - Add PerlIO/Scalar to list of extensions in win32/makefile.mk
 - Fixup makedef.pl for latest set of symbols.

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

diff --git a/iperlsys.h b/iperlsys.h
index 8a628cd..6c093dd 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -880,6 +880,8 @@ typedef int		(*LPProcKillpg)(struct IPerlProc*, int, int);
 typedef int		(*LPProcPauseProc)(struct IPerlProc*);
 typedef PerlIO*		(*LPProcPopen)(struct IPerlProc*, const char*,
 			    const char*);
+typedef PerlIO*		(*LPProcPopenList)(struct IPerlProc*, const char*,
+			    IV narg, SV **args);
 typedef int		(*LPProcPclose)(struct IPerlProc*, PerlIO*);
 typedef int		(*LPProcPipe)(struct IPerlProc*, int*);
 typedef int		(*LPProcSetuid)(struct IPerlProc*, uid_t);
@@ -942,6 +944,7 @@ struct IPerlProc
     LPProcASpawn	pASpawn;
 #endif
     LPProcLastHost      pLastHost;
+    LPProcPopenList	pPopenList;
 };
 
 struct IPerlProcInfo
diff --git a/makedef.pl b/makedef.pl
index f165a90..583eada 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -547,8 +547,10 @@ my @layer_syms = qw(
 			 PerlIOBase_eof
 			 PerlIOBase_error
 			 PerlIOBase_fileno
+			 PerlIOBase_setlinebuf
+			 PerlIOBase_pushed
+			 PerlIOBase_read
 			 PerlIOBuf_bufsiz
-			 PerlIOBuf_fdopen
 			 PerlIOBuf_fill
 			 PerlIOBuf_flush
 			 PerlIOBuf_get_cnt
@@ -556,15 +558,15 @@ my @layer_syms = qw(
 			 PerlIOBuf_open
 			 PerlIOBuf_pushed
 			 PerlIOBuf_read
-			 PerlIOBuf_reopen
 			 PerlIOBuf_seek
 			 PerlIOBuf_set_ptrcnt
-			 PerlIOBuf_setlinebuf
 			 PerlIOBuf_tell
 			 PerlIOBuf_unread
 			 PerlIOBuf_write
 			 PerlIO_define_layer
+			 PerlIO_arg_fetch
 			 PerlIO_pending
+			 PerlIO_allocate
 			 PerlIO_push
 			 PerlIO_unread
 );
@@ -924,8 +926,10 @@ PerlIOBuf_set_ptrcnt
 PerlIOBuf_get_cnt
 PerlIOBuf_get_ptr
 PerlIOBuf_bufsiz
-PerlIOBuf_setlinebuf
 PerlIOBase_clearerr
+PerlIOBase_setlinebuf
+PerlIOBase_pushed
+PerlIOBase_read
 PerlIOBase_error
 PerlIOBase_eof
 PerlIOBuf_tell
@@ -933,9 +937,7 @@ PerlIOBuf_seek
 PerlIOBuf_write
 PerlIOBuf_unread
 PerlIOBuf_read
-PerlIOBuf_reopen
 PerlIOBuf_open
-PerlIOBuf_fdopen
 PerlIOBase_fileno
 PerlIOBuf_pushed
 PerlIOBuf_fill
@@ -945,6 +947,8 @@ PerlIO_define_layer
 PerlIO_pending
 PerlIO_unread
 PerlIO_push
+PerlIO_allocate
+PerlIO_arg_fetch
 PerlIO_apply_layers
 perlsio_binmode
 PerlIO_binmode
diff --git a/perlio.c b/perlio.c
index 46cafa0..94b7c17 100644
--- a/perlio.c
+++ b/perlio.c
@@ -684,8 +684,8 @@ PerlIO_push(pTHX_ PerlIO *f,PerlIO_funcs *tab,const char *mode,SV *arg)
    l->next = *f;
    l->tab  = tab;
    *f      = l;
-   PerlIO_debug("PerlIO_push f=%p %s %s '%s'\n",f,tab->name,
-                 (mode) ? mode : "(Null)",(arg) ? SvPV_nolen(arg) : "(Null)");
+   PerlIO_debug("PerlIO_push f=%p %s %s %p\n",f,tab->name,
+                 (mode) ? mode : "(Null)",arg);
    if ((*l->tab->Pushed)(f,mode,arg) != 0)
     {
      PerlIO_pop(aTHX_ f);
@@ -754,7 +754,7 @@ PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode, AV *layers, IV n)
     {
      if (!PerlIO_push(aTHX_ f,tab,mode,PerlIOArg))
       {
-       code -1;
+       code = -1;
        break;
       }
     }
@@ -2306,6 +2306,7 @@ PerlIOBuf_pushed(PerlIO *f, const char *mode, SV *arg)
  PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
  int fd  = PerlIO_fileno(f);
  Off_t posn;
+ dTHX;
  if (fd >= 0 && PerlLIO_isatty(fd))
   {
    PerlIOBase(f)->flags |= PERLIO_F_LINEBUF;
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 5c21ebb..ef21bda 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -743,7 +743,7 @@ SETARGV_OBJ	= setargv$(o)
 
 DYNAMIC_EXT	= Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \
 		Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \
-		Sys/Hostname Storable Filter/Util/Call Encode
+		Sys/Hostname Storable Filter/Util/Call Encode PerlIO/Scalar
 STATIC_EXT	= DynaLoader
 NONXS_EXT	= Errno
 
@@ -759,6 +759,7 @@ THREAD		= $(EXTDIR)\Thread\Thread
 B		= $(EXTDIR)\B\B
 RE		= $(EXTDIR)\re\re
 DUMPER		= $(EXTDIR)\Data\Dumper\Dumper
+SCALAR		= $(EXTDIR)\PerlIO\Scalar\Scalar
 ERRNO		= $(EXTDIR)\Errno\Errno
 PEEK		= $(EXTDIR)\Devel\Peek\Peek
 BYTELOADER	= $(EXTDIR)\ByteLoader\ByteLoader
@@ -779,6 +780,7 @@ ATTRS_DLL	= $(AUTODIR)\attrs\attrs.dll
 THREAD_DLL	= $(AUTODIR)\Thread\Thread.dll
 B_DLL		= $(AUTODIR)\B\B.dll
 DUMPER_DLL	= $(AUTODIR)\Data\Dumper\Dumper.dll
+SCALAR_DLL	= $(AUTODIR)\PerlIO\Scalar\Scalar.dll
 PEEK_DLL	= $(AUTODIR)\Devel\Peek\Peek.dll
 RE_DLL		= $(AUTODIR)\re\re.dll
 BYTELOADER_DLL	= $(AUTODIR)\ByteLoader\ByteLoader.dll
@@ -802,6 +804,7 @@ EXTENSION_C	=		\
 		$(THREAD).c	\
 		$(RE).c		\
 		$(DUMPER).c	\
+		$(SCALARR).c	\
 		$(PEEK).c	\
 		$(B).c		\
 		$(BYTELOADER).c	\
@@ -821,6 +824,7 @@ EXTENSION_DLL	=		\
 		$(POSIX_DLL)	\
 		$(ATTRS_DLL)	\
 		$(DUMPER_DLL)	\
+		$(SCALAR_DLL)	\
 		$(PEEK_DLL)	\
 		$(B_DLL)	\
 		$(RE_DLL)	\
@@ -1140,6 +1144,11 @@ $(DUMPER_DLL): $(PERLDEP) $(DUMPER).xs
 	..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl
 	cd $(EXTDIR)\Data\$(*B) && $(MAKE)
 
+$(SCALAR_DLL): $(PERLDEP) $(SCALAR).xs
+	cd $(EXTDIR)\PerlIO\$(*B) && \
+	..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl
+	cd $(EXTDIR)\PerlIO\$(*B) && $(MAKE)
+
 $(DPROF_DLL): $(PERLDEP) $(DPROF).xs
 	cd $(EXTDIR)\Devel\$(*B) && \
 	..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl
@@ -1275,6 +1284,7 @@ distclean: clean
 	-del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm
 	-del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm
 	-del /f $(LIBDIR)\Data\Dumper.pm $(LIBDIR)\ByteLoader.pm
+	-del /f $(LIBDIR)\PerlIO\Scalar.pm
 	-del /f $(LIBDIR)\Devel\Peek.pm $(LIBDIR)\Devel\DProf.pm
 	-del /f $(LIBDIR)\File\Glob.pm
 	-del /f $(LIBDIR)\Storable.pm
diff --git a/win32/perlhost.h b/win32/perlhost.h
index 719d82a..815be84 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -1594,6 +1594,14 @@ PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
     return win32_popen(command, mode);
 }
 
+PerlIO*
+PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
+{
+    dTHXo;
+    PERL_FLUSHALL_FOR_CHILD;
+    return win32_popenlist(mode, narg, args);
+}
+
 int
 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
 {
@@ -1893,7 +1901,8 @@ struct IPerlProc perlProc =
     PerlProcSpawn,
     PerlProcSpawnvp,
     PerlProcASpawn,
-    PerlProcLastHost
+    PerlProcLastHost,
+    PerlProcPopenList
 };
 
 
diff --git a/win32/win32.c b/win32/win32.c
index 226ef9b..d2d70e5 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -2356,6 +2356,14 @@ win32_pipe(int *pfd, unsigned int size, int mode)
     return _pipe(pfd, size, mode);
 }
 
+DllExport PerlIO*
+win32_popenlist(const char *mode, IV narg, SV **args)
+{
+ dTHX;
+ Perl_croak(aTHX_ "List form of pipe open not implemented");
+ return NULL;
+}
+
 /*
  * a popen() clone that respects PERL5SHELL
  *
diff --git a/win32/win32iop.h b/win32/win32iop.h
index 5412f5e..4d78839 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -73,6 +73,7 @@ DllExport  int  	win32_fstat(int fd,struct stat *sbufptr);
 DllExport  int  	win32_stat(const char *name,struct stat *sbufptr);
 DllExport  int		win32_pipe( int *phandles, unsigned int psize, int textmode );
 DllExport  PerlIO*	win32_popen( const char *command, const char *mode );
+DllExport  PerlIO*	win32_popenlist(const char *mode, IV narg, SV **args);
 DllExport  int		win32_pclose( PerlIO *pf);
 DllExport  int		win32_rename( const char *oname, const char *newname);
 DllExport  int		win32_setmode( int fd, int mode);