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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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);