Ajout {set,clear}_nonblock. Cas special Unix.select lorsque les 3 listes de descripteurs sont vides. Correction bug traitement d'erreur dans Unix.accept. PR#1499

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@5375 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

6 files changed, 83 insertions, 25 deletions

diff --git a/otherlibs/win32unix/Makefile.nt b/otherlibs/win32unix/Makefile.nt
index 76d7f53f4..b873b16dd 100644
--- a/otherlibs/win32unix/Makefile.nt
+++ b/otherlibs/win32unix/Makefile.nt
@@ -26,7 +26,7 @@ COMPFLAGS=-warn-error A
 WIN_FILES = accept.c bind.c channels.c close.c \
   close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
   getpeername.c getpid.c getsockname.c gettimeofday.c \
-  link.c listen.c lockf.c lseek.c \
+  link.c listen.c lockf.c lseek.c nonblock.c \
   mkdir.c open.c pipe.c read.c rename.c \
   select.c sendrecv.c \
   shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
diff --git a/otherlibs/win32unix/accept.c b/otherlibs/win32unix/accept.c
index fdac3e5da..ec7068bd3 100644
--- a/otherlibs/win32unix/accept.c
+++ b/otherlibs/win32unix/accept.c
@@ -29,6 +29,7 @@ CAMLprim value unix_accept(sock)
   int oldvalue, oldvaluelen, newvalue, retcode;
   union sock_addr_union addr;
   socklen_param_type addr_len;
+  int errcode = 0;
 
   oldvaluelen = sizeof(oldvalue);
   retcode = getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
@@ -43,13 +44,15 @@ CAMLprim value unix_accept(sock)
   enter_blocking_section();
   snew = accept(sconn, &addr.s_gen, &addr_len);
   leave_blocking_section();
+  if( snew == INVALID_SOCKET )
+    errcode = WSAGetLastError ();
   if (retcode == 0) {
     /* Restore initial mode */
     setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, 
                (char *) &oldvalue, oldvaluelen);
   }
   if (snew == INVALID_SOCKET) {
-    win32_maperr(WSAGetLastError());
+    win32_maperr(errcode);
     uerror("accept", Nothing);
   }
   Begin_roots2 (fd, adr)
diff --git a/otherlibs/win32unix/errmsg.c b/otherlibs/win32unix/errmsg.c
index f1246ab82..20a8c8d58 100644
--- a/otherlibs/win32unix/errmsg.c
+++ b/otherlibs/win32unix/errmsg.c
@@ -13,6 +13,7 @@
 
 /* $Id$ */
 
+#include <stdio.h>
 #include <errno.h>
 #include <string.h>
 #include <mlvalues.h>
@@ -37,6 +38,7 @@ CAMLprim value unix_error_message(value err)
                     sizeof(buffer),
                     NULL))
     return copy_string(buffer);
-  return copy_string("unknown error");
+  sprintf(buffer, "unknown error #%d", errnum);  
+  return copy_string(buffer);
 }
 
diff --git a/otherlibs/win32unix/nonblock.c b/otherlibs/win32unix/nonblock.c
new file mode 100755
index 000000000..733a79d89
--- /dev/null
+++ b/otherlibs/win32unix/nonblock.c
@@ -0,0 +1,42 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 2002 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../../LICENSE.  */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+#include <mlvalues.h>
+#include <signals.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_set_nonblock(socket)
+     value socket;
+{
+  u_long non_block = 1;
+
+  if (ioctlsocket(Socket_val(socket), FIONBIO, &non_block) != 0) {
+    win32_maperr(WSAGetLastError());
+    uerror("unix_set_nonblock", Nothing);
+  }
+  return Val_unit;
+}
+
+CAMLprim value unix_clear_nonblock(socket)
+     value socket;
+{
+  u_long non_block = 0;
+
+  if (ioctlsocket(Socket_val(socket), FIONBIO, &non_block) != 0) {
+    win32_maperr(WSAGetLastError());
+    uerror("unix_clear_nonblock", Nothing);
+  }
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/select.c b/otherlibs/win32unix/select.c
index 74aad826e..44930f7a7 100644
--- a/otherlibs/win32unix/select.c
+++ b/otherlibs/win32unix/select.c
@@ -57,27 +57,38 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
 
   Begin_roots3 (readfds, writefds, exceptfds)
   Begin_roots3 (read_list, write_list, except_list)
-    fdlist_to_fdset(readfds, &read);
-    fdlist_to_fdset(writefds, &write);
-    fdlist_to_fdset(exceptfds, &except);
-    tm = Double_val(timeout);
-    if (tm < 0.0)
-      tvp = (struct timeval *) NULL;
-    else {
-      tv.tv_sec = (int) tm;
-      tv.tv_usec = (int) (1e6 * (tm - (int) tm));
-      tvp = &tv;
-    }
-    enter_blocking_section();
-    retcode = select(FD_SETSIZE, &read, &write, &except, tvp);
-    leave_blocking_section();
-    if (retcode == -1) {
-      win32_maperr(WSAGetLastError());
-      uerror("select", Nothing);
+    if (readfds == Val_int(0)
+	&& writefds == Val_int(0)
+	&& exceptfds == Val_int(0)) {
+      if ( tm > 0.0 ) {
+	enter_blocking_section();
+	Sleep( (int)(tm * 1000));
+	leave_blocking_section();
+      }
+      read_list = write_list = except_list = Val_int(0);
+    } else {      
+      fdlist_to_fdset(readfds, &read);
+      fdlist_to_fdset(writefds, &write);
+      fdlist_to_fdset(exceptfds, &except);
+      tm = Double_val(timeout);
+      if (tm < 0.0)
+	tvp = (struct timeval *) NULL;
+      else {
+	tv.tv_sec = (int) tm;
+	tv.tv_usec = (int) (1e6 * (tm - (int) tm));
+	tvp = &tv;
+      }
+      enter_blocking_section();
+      retcode = select(FD_SETSIZE, &read, &write, &except, tvp);
+      leave_blocking_section();
+      if (retcode == -1) {
+	win32_maperr(WSAGetLastError());
+	uerror("select", Nothing);
+      }
+      read_list = fdset_to_fdlist(readfds, &read);
+      write_list = fdset_to_fdlist(writefds, &write);
+      except_list = fdset_to_fdlist(exceptfds, &except);
     }
-    read_list = fdset_to_fdlist(readfds, &read);
-    write_list = fdset_to_fdlist(writefds, &write);
-    except_list = fdset_to_fdlist(exceptfds, &except);
     res = alloc_small(3, 0);
     Field(res, 0) = read_list;
     Field(res, 1) = write_list;
diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml
index ed9c809cb..f7a7e9ee7 100644
--- a/otherlibs/win32unix/unix.ml
+++ b/otherlibs/win32unix/unix.ml
@@ -303,8 +303,8 @@ external access : string -> access_permission list -> unit = "unix_access"
 external dup : file_descr -> file_descr = "unix_dup"
 external dup2 : file_descr -> file_descr -> unit = "unix_dup2"
 
-let set_nonblock fd = ()
-let clear_nonblock fd = ()
+external set_nonblock : file_descr -> unit = "unix_set_nonblock"
+external clear_nonblock : file_descr -> unit = "unix_clear_nonblock"
 
 external set_close_on_exec : file_descr -> unit = "win_set_close_on_exec"
 external clear_close_on_exec : file_descr -> unit = "win_clear_close_on_exec"