cleanup (III)

release.sh

@@ -36,6 +36,7 @@ else
 fi
 
 cd "$mtmpf"
+rm -f .git*
 
 $find . -type f ! -executable ! -perm 644 -exec chmod 644 {} \+
 $find . -type f -executable ! -perm 755 -exec chmod 755 {} \+

src/OMakefile

@@ -11,15 +11,15 @@ if $(equal $(OSTYPE),Win32)
 		else
 			touch configure config.h.in
 	config.h config.inc: config.h.in configure config.inc.in
-		bash.exe configure CC="$(OCAMLC_CC)" CFLAGS="$(CFLAGS) $(CFLAGS_LIBUV)"  LDFLAGS="$(LDFLAGS_LIBUV)"
+		bash.exe configure CC="$(OCAMLC_CC)" CFLAGS="$(CFLAGS) $(CFLAGS_LIBUV)"  LDFLAGS="$(LDFLAGS) $(LDFLAGS_LIBUV)"
 else
 	configure config.h.in: configure.ac
 		if $(or $(not $(file-exists configure)),$(not $(file-exists config.h.in)))
 			autoreconf -fi
 		else
 			touch configure config.h.in
 	config.h config.inc: config.h.in configure config.inc.in
-		./configure CC="$(OCAMLC_CC)" CFLAGS="$(CFLAGS) $(CFLAGS_LIBUV)"  LDFLAGS="$(LDFLAGS_LIBUV)"
+		./configure CC="$(OCAMLC_CC)" CFLAGS="$(CFLAGS) $(CFLAGS_LIBUV)"  LDFLAGS="$(LDFLAGS) $(LDFLAGS_LIBUV)"
 
 clean::
 	rm -f config.log config.status

src/emap_gen.c

@@ -180,7 +180,7 @@ int main(void)
   }
 
   fputs("typedef enum {\n",c2);
-  for (i=0; i< AR_SIZE(er_map); ++i){
+  for ( i = 0; i < AR_SIZE(er_map); ++i ){
     int val = er_map[i];
     const char * x = err_name(val);
     if ( val == UV_UWT_UNKNOWN ){
@@ -197,7 +197,7 @@ int main(void)
   fputs("#pragma GCC diagnostic push\n"
     "#pragma GCC diagnostic ignored \"-Wenum-compare\"\n",c);
 
-  for (i=0; i< AR_SIZE(er_map); ++i){
+  for ( i = 0; i < AR_SIZE(er_map); ++i ){
     int val = er_map[i];
     const char * x = err_name(val);
     if ( x[0] != 'U' || x[1] != 'W' || x[2] != 'T' ){
@@ -217,15 +217,15 @@ int main(void)
   fputs("#pragma GCC diagnostic pop\n\n",c);
 
   fputs("typedef enum {\n",c2);
-  for (i=0; i< AR_SIZE(er_map); ++i){
+  for ( i = 0; i < AR_SIZE(er_map); ++i ){
     int val = er_map[i];
     const char * x = err_name(val);
     fprintf(c2,"  VAL_UWT_ERROR_%s = (Val_long(%d)),\n",x,i);
   }
   fputs("} val_uwt_error_t;\n\n",c2);
 
   fputs("typedef enum {\n",c2);
-  for (i=0; i< AR_SIZE(er_map); ++i){
+  for ( i = 0; i < AR_SIZE(er_map); ++i ){
     int val = er_map[i];
     const char * x = err_name(val);
     fprintf(c2,"  VAL_UWT_INT_RESULT_%s = (Val_long(%d)),\n",x,neg_result(i));
@@ -239,7 +239,7 @@ int main(void)
         "{\n"
         "  value erg;\n"
         "  switch (n) {\n",c);
-  for (i=0; i< AR_SIZE(er_map); ++i){
+  for ( i = 0; i < AR_SIZE(er_map); ++i ){
     int val = er_map[i];
     const char * x = err_name(val);
     fprintf(c,"  case UV_%s: erg = Val_long(%u) ; break;\n",x,i);
@@ -260,7 +260,7 @@ int main(void)
         "    return Val_long(n);\n"
         "  }\n"
         "  switch (n) {\n",c);
-  for (i=0; i< AR_SIZE(er_map); ++i){
+  for ( i = 0; i < AR_SIZE(er_map); ++i ){
     int val = er_map[i];
     const char * x = err_name(val);
     fprintf(c,"  case UV_%s: erg = Val_long(%d) ; break;\n",x,neg_result(i));
@@ -275,7 +275,7 @@ int main(void)
 
   fputs("static const int16_t error_rev_map[] = {\n",c);
 
-  for (i=0; i< AR_SIZE(er_map); ++i){
+  for ( i = 0; i < AR_SIZE(er_map); ++i ){
     int val = er_map[i];
     const char * x = err_name(val);
     fprintf(c," UV_%s,\n",x);
@@ -297,7 +297,7 @@ int main(void)
     "  const char * msg;\n"
     "  switch(t){\n" ,c );
 
-  for (i=0; i< AR_SIZE(er_map); ++i){
+  for ( i = 0; i < AR_SIZE(er_map); ++i ){
     int val = er_map[i];
     const char * x = err_name(val);
     if ( x[0] == 'U' && x[1] == 'W' && x[2] == 'T' ){
@@ -310,14 +310,14 @@ int main(void)
         "}\n" ,c );
 
   fputs("type error = \n",ml);
-  for (i=0; i< AR_SIZE(er_map); ++i){
+  for ( i = 0; i < AR_SIZE(er_map); ++i ){
     int val = er_map[i];
     const char * x = err_name(val);
     fprintf(ml,"| %s\n",x);
   }
   fputs("\n",ml);
   fputs("let err_name = function\n",ml);
-  for (i=0; i< AR_SIZE(er_map); ++i){
+  for ( i = 0; i < AR_SIZE(er_map); ++i ){
     int val = er_map[i];
     const char * x = err_name(val);
     fprintf(ml,"| %s -> \"%s\"\n",x,x);
@@ -344,7 +344,7 @@ int main(void)
 
   ml = fopen("error_val.ml","w");
   c = fopen("error_val.mli","w");
-  for ( i = 0 ; i< AR_SIZE(er_map) ; ++i ){
+  for ( i = 0 ; i < AR_SIZE(er_map) ; ++i ){
     int val = er_map[i];
     char * x = lower_err_name(val);
     fprintf(ml,"let %s = %d\n",x,neg_result(i));

src/macros.h

@@ -118,8 +118,12 @@
 #define DEBUG_PF_R(n,...)                       \
   DEBUG_PF_RR(n,__VA_ARGS__)
 
+#ifdef NDEBUG
+#define DEBUG_PF(...)
+#else
 #define DEBUG_PF(...)                           \
   DEBUG_PF_R(PP_NARG(__VA_ARGS__),__VA_ARGS__)
+#endif
 
 #ifndef R_OK
 # ifdef __R_OK

src/uwt-worker.h

@@ -57,8 +57,13 @@ uwt_add_worker_result(value o_uwt,
                       void * p1,
                       void * p2);
 
+#if defined(__GNUC__) && __GNUC__ >= 3
+value Val_uwt_error(int n) __attribute__ ((const));
+value Val_uwt_int_result(int n) __attribute__ ((const));
+#else
 value Val_uwt_error(int n);
 value Val_uwt_int_result(int n);
+#endif
 
 #ifdef _WIN32
 int uwt_translate_sys_error(DWORD);

src/uwt.ml

@@ -39,6 +39,11 @@ open Lwt.Infix
 external init_stacks : unit -> unit = "uwt_init_stacks_na" "noalloc"
 let () = init_stacks ()
 
+#if HAVE_WINDOWS <> 0
+external init_unix_windows : unit -> unit = "uwt_unix_windows_init_na" "noalloc"
+let () = init_unix_windows ()
+#endif
+
 include Uwt_base
 
 module LInt_result = struct
@@ -92,7 +97,7 @@ external uv_default_loop: int -> loop result = "uwt_default_loop"
 let loop =
   match uv_default_loop 1 with (* Lwt of disabled loop_mode *)
   | Error _ ->
-    prerr_endline "Can't init default loop";
+    prerr_endline "uwt error: can't initialize default loop";
     exit(3)
   | Ok x -> x
 
@@ -581,6 +586,8 @@ module Stream = struct
     in
     if pos < 0 || len < 0 || pos > dim - len then
       Lwt.fail (Invalid_argument "Uwt.Stream.read")
+    else if len = 0 then
+      Lwt.return 0
     else
       let sleeper,waker = Lwt.task () in
       let (x: Int_result.unit) = read t buf pos len waker in
@@ -604,11 +611,10 @@ module Stream = struct
     read ?pos ?len ~dim ~buf t
 
   external write2:
-    t -> t -> Bytes.t -> int -> int -> unit_cb -> Int_result.unit =
+    t -> t -> 'a -> int -> int -> unit_cb -> Int_result.unit =
     "uwt_write2_byte" "uwt_write2_native"
 
-  let write2 ?(pos=0) ?len ~buf ~send s =
-    let dim = Bytes.length buf in
+  let write2 ?(pos=0) ?len ~buf ~send ~dim s =
     let len =
       match len with
       | None -> dim - pos
@@ -619,6 +625,18 @@ module Stream = struct
     else
       qsu5 ~name:"write2" ~f:write2 s send buf pos len
 
+  let write2_ba ?pos ?len ~(buf:buf) ~send t =
+    let dim = Bigarray.Array1.dim buf in
+    write2 ?pos ?len ~buf ~send ~dim t
+
+  let write2_string ?pos ?len ~buf ~send t =
+    let dim = String.length buf in
+    write2 ?pos ?len ~buf ~send ~dim t
+
+  let write2 ?pos ?len ~buf ~send t =
+    let dim = Bytes.length buf in
+    write2 ?pos ?len ~buf ~send ~dim t
+
   external is_readable : t -> bool = "uwt_is_readable_na" "noalloc"
   external is_writable : t -> bool = "uwt_is_writable_na" "noalloc"
 
@@ -657,8 +675,8 @@ module Pipe = struct
     | Error ENOMEM -> raise Out_of_memory
     | Error x ->
       (* this can currently not happen. loop is initialized at program
-         start - an will never be closed (UWT_EFATAL not possible).
-         And uv_tcp_init always returns zero. But the libuv internals
+         start - and will never be closed (UWT_EFATAL not possible).
+         And uv_pipe_init always returns zero. But the libuv internals
          might change in future versions,... *)
       eraise "pipe_init" x
 
@@ -1056,6 +1074,8 @@ module Udp = struct
     in
     if pos < 0 || len < 0 || pos > dim - len then
       Lwt.fail (Invalid_argument "Uwt.Udp.recv")
+    else if len = 0 then
+      Lwt.return ({ recv_len = 0; is_partial = false ; sockaddr = None })
     else
       let sleeper,waker = Lwt.task () in
       let x = recv t buf pos len waker in
@@ -1082,18 +1102,17 @@ module Timer = struct
   include (Handle: (module type of Handle) with type t := t )
   external to_handle : t -> Handle.t = "%identity"
 
-  (* external stop: t -> Int_result.unit = "uwt_timer_stop"
-  let stop = stop
-  let stop_exn t = stop t |> to_exnu "timver_stop" *)
-
   external start:
     loop -> ( t -> unit ) -> int -> int -> t result = "uwt_timer_start"
 
-  let start_exn ~repeat ~timeout ~cb =
-    start loop cb timeout repeat |> to_exn "timer_start"
-
   let start ~repeat ~timeout ~cb =
-    start loop cb timeout repeat
+    if repeat < 0 || timeout < 0 then
+      Error UWT_EINVAL
+    else
+      start loop cb timeout repeat
+
+  let start_exn ~repeat ~timeout ~cb =
+    start ~cb ~timeout ~repeat |> to_exn "timer_start"
 
   let sleep s =
     let sleeper,waker = Lwt.task () in
@@ -1118,9 +1137,6 @@ module Signal = struct
 
   let start_exn i ~cb = start loop i cb |> to_exn "signal_start"
   let start i ~cb = start loop i cb
-
-  (* external stop: t -> Int_result.unit = "uwt_signal_stop"
-  let stop_exn t = stop t |> to_exnu "signal_stop" *)
 end
 
 module Poll = struct
@@ -1164,9 +1180,6 @@ module Fs_event = struct
 
   let start_exn s fl ~cb = start loop s fl cb |> to_exn "fs_event_start"
   let start s fl ~cb = start loop s fl cb
-
-(*  external stop: t -> Int_result.unit = "uwt_fs_event_stop"
-  let stop_exn t = stop t |> to_exnu "fs_event_stop" *)
 end
 
 module Fs_poll = struct
@@ -1185,9 +1198,6 @@ module Fs_poll = struct
 
   let start_exn s fl ~cb = start loop s fl cb |> to_exn "fs_poll_start"
   let start s fl ~cb = start loop s fl cb
-
-(*  external stop: t -> Int_result.unit = "uwt_fs_poll_stop"
-  let stop_exn t = stop t |> to_exnu "fs_poll_stop" *)
 end
 
 module Dns = struct

src/uwt.mli

@@ -298,6 +298,8 @@ module Stream : sig
   val write_raw_ba : ?pos:int -> ?len:int -> t -> buf:buf -> unit Lwt.t
 
   val write2 : ?pos:int -> ?len:int -> buf:bytes -> send:t -> t -> unit Lwt.t
+  val write2_ba : ?pos:int -> ?len:int -> buf:buf -> send:t -> t -> unit Lwt.t
+  val write2_string : ?pos:int -> ?len:int -> buf:string -> send:t -> t -> unit Lwt.t
 
   val listen:
     t -> max:int -> cb:( t -> Int_result.unit -> unit ) -> Int_result.unit
@@ -748,14 +750,8 @@ module Unix : sig
   val pipe : ?cloexec: bool -> unit -> (Pipe.t * Pipe.t) result
   val pipe_exn : ?cloexec: bool -> unit -> Pipe.t * Pipe.t
 
-  (** wrapper around realpath under Unix and GetFullPathName (and an
-      additional check if the file exists) under windows.
-
-      Be careful:
-      - realpath/GetFullPathName is not thread-safe, but the
-        function is called in a work thread.
-      - The windows version doesn't resolve symlinks at the moment.
-  *)
+  (** wrapper around realpath under Unix and GetFinalPathNameByHandleW
+      or GetFullPathName under windows. *)
   val realpath: string -> string Lwt.t
 end
 

src/uwt_base.ml

@@ -79,7 +79,7 @@ module Int_result = struct
     else
       Uwt_error(transform x,name,param)
 
-               #include "error_val.ml"
+#include "error_val.ml"
 end
 
 type file = Unix.file_descr