diff options
author | Jérôme Vouillon <vouillon@pps.jussieu.fr> | 2012-08-07 16:24:45 +0000 |
---|---|---|
committer | Jérôme Vouillon <vouillon@pps.jussieu.fr> | 2012-08-07 16:24:45 +0000 |
commit | 7b50c7ff5980286c51dba48989187a60df47e2d1 (patch) | |
tree | 83c76b2cfdf929ab5133190e81797580b473a725 | |
parent | b42eff0040ad937796812cb77aed428ff444d032 (diff) | |
download | unison-7b50c7ff5980286c51dba48989187a60df47e2d1.zip unison-7b50c7ff5980286c51dba48989187a60df47e2d1.tar.gz unison-7b50c7ff5980286c51dba48989187a60df47e2d1.tar.bz2 |
* Fix bug in Lwt_unix.sleep
-rw-r--r-- | src/RECENTNEWS | 5 | ||||
-rw-r--r-- | src/lwt/generic/lwt_unix_impl.ml | 6 | ||||
-rw-r--r-- | src/mkProjectInfo.ml | 1 | ||||
-rw-r--r-- | src/test.ml | 2 |
4 files changed, 11 insertions, 3 deletions
diff --git a/src/RECENTNEWS b/src/RECENTNEWS index 4122416..fba3152 100644 --- a/src/RECENTNEWS +++ b/src/RECENTNEWS @@ -1,3 +1,8 @@ +CHANGES FROM VERSION 2.45.11 + +* Fix bug in Lwt_unix.sleep + +------------------------------- CHANGES FROM VERSION 2.45.9 * Added some more debugging code in transfer.ml diff --git a/src/lwt/generic/lwt_unix_impl.ml b/src/lwt/generic/lwt_unix_impl.ml index 111def4..09f007a 100644 --- a/src/lwt/generic/lwt_unix_impl.ml +++ b/src/lwt/generic/lwt_unix_impl.ml @@ -128,8 +128,10 @@ let rec run thread = ([], [], []) else try - let res = Unix.select infds outfds [] delay in - if delay > 0. && !now <> -1. then now := !now +. delay; + let (readers, writers, _) as res = + Unix.select infds outfds [] delay in + if delay > 0. && !now <> -1. && readers = [] && writers = [] then + now := !now +. delay; res with Unix.Unix_error (Unix.EINTR, _, _) -> diff --git a/src/mkProjectInfo.ml b/src/mkProjectInfo.ml index 83a8244..4f4c04e 100644 --- a/src/mkProjectInfo.ml +++ b/src/mkProjectInfo.ml @@ -73,3 +73,4 @@ Printf.printf "NAME=%s\n" projectName;; + diff --git a/src/test.ml b/src/test.ml index eb12176..2f428e6 100644 --- a/src/test.ml +++ b/src/test.ml @@ -370,7 +370,7 @@ let test() = check "4" R2 (Dir ["x", File "foo"]); ); - raise (Util.Fatal "Skipping some tests -- remove me!\n"); + (raise (Util.Fatal "Skipping some tests -- remove me!\n") : unit); if bothRootsLocal then runtest "backups 1 (local)" ["backup = Name *"] (fun() -> |