[ID 20001025.011] [PATCH] t/io/open.t perl@7369[ 7350] breaks VMS perl

[p5sagit/p5-mst-13.2.git] / doio.c

diff --git a/doio.c b/doio.c
index ea5ab29..87e53a4 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -59,7 +59,15 @@
 #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
 # include <sys/socket.h>
 # if defined(USE_SOCKS) && defined(I_SOCKS)
+#   if !defined(INCLUDE_PROTOTYPES)
+#       define INCLUDE_PROTOTYPES /* for <socks.h> */
+#       define PERL_SOCKS_NEED_PROTOTYPES
+#   endif
 #   include <socks.h>
+#   ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */
+#       undef INCLUDE_PROTOTYPES
+#       undef PERL_SOCKS_NEED_PROTOTYPES
+#   endif 
 # endif 
 # ifdef I_NETBSD
 #  include <netdb.h>
@@ -314,7 +322,13 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                             * be optimized away on most platforms;
                             * only Solaris and Linux seem to flush
                             * on that. --jhi */
-                           PerlIO_seek(fp, 0, SEEK_CUR);
+#ifdef USE_SFIO
+                           /* sfio fails to clear error on next
+                              sfwrite, contrary to documentation.
+                              -- Nick Clark */
+                           if (PerlIO_seek(fp, 0, SEEK_CUR) == -1)
+                               PerlIO_clearerr(fp);
+#endif
                            /* On the other hand, do all platforms
                             * take gracefully to flushing a read-only
                             * filehandle?  Perhaps we should do
@@ -1180,6 +1194,11 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
        }
        /* FALL THROUGH */
     default:
+#if 0
+       /* XXX Fix this when the I/O disciplines arrive. XXX */
+       if (DO_UTF8(sv))
+           sv_utf8_downgrade(sv, FALSE);
+#endif
        tmps = SvPV(sv, len);
        break;
     }
@@ -1189,7 +1208,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
      * but only until the system hard limit/the filesystem limit,
      * at which we would get EPERM.  Note that when using buffered
      * io the write failure can be delayed until the flush/close. --jhi */
-    if (len && (PerlIO_write(fp,tmps,len) == 0 || PerlIO_error(fp)))
+    if (len && (PerlIO_write(fp,tmps,len) == 0))
        return FALSE;
     return !PerlIO_error(fp);
 }