This is an automated email from the git hooks/post-receive script. glondu pushed a commit to branch master in repository lwt.
commit 5bf883030994edb9c066544a694e2257a3f78846 Author: Stephane Glondu <st...@glondu.net> Date: Thu Jul 28 09:53:41 2016 +0200 Imported Upstream version 2.5.2 --- CHANGES | 9 ++++ RELEASE.md | 15 ------ _oasis | 2 +- manual/manual.wiki | 33 ++++++++++-- ppx/ppx_lwt.mli | 117 ++++++++++++++++++++++------------------- ppx/ppx_lwt_ex.ml | 23 ++++---- setup-dev.exe | Bin 3510672 -> 0 bytes setup.ml | 6 +-- src/core/META | 26 ++++----- src/core/lwt.mli | 13 ++++- src/core/lwt_stream.ml | 9 ++++ src/unix/lwt_daemon.ml | 61 ++++++++++----------- src/unix/lwt_daemon.mli | 1 - src/unix/lwt_io.mli | 2 +- src/unix/lwt_process.ml | 12 +++-- src/unix/lwt_unix.mli | 4 +- src/unix/lwt_unix_unix.c | 2 +- tests/META | 4 +- tests/core/test_lwt_stream.ml | 17 ++++++ tests/unix/main.ml | 1 + tests/unix/test_lwt_process.ml | 16 ++++++ 21 files changed, 228 insertions(+), 145 deletions(-) diff --git a/CHANGES b/CHANGES index 56e294e..72bfae9 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,12 @@ +===== 2.5.2 (2015-04-25) ===== + + * Fix compatibility for 4.03 (#227) + * Various documentation fixes (#199,#200,#210,) + * Improve wildcard detection in the ppx (#198) + * Fix Lwt_stream: bounded_push#close wake the reader (#201) + * Fix infinite loop with Lwt_stream.choose (#214) + * Fix lazyness failure with Lwt_io.common#close (#207) + ===== 2.5.1 (2015-12-07) ===== * Lwt_stream.on_terminate -> Lwt_stream.on_termination diff --git a/RELEASE.md b/RELEASE.md deleted file mode 100644 index 6bfa22b..0000000 --- a/RELEASE.md +++ /dev/null @@ -1,15 +0,0 @@ -# How to make a release. - - -- Bump the relevant version numbers: - - Oasis - - CHANGES -- `sh dist.sh`. It creates a tag and a branch numbered by the version. -- Push **only the tag and not the branch**. You obtain a tag with no branch. -- Let github create a tarball. -- Delete the local branch. - -- In [ocsigen.org-data](https://github.com/ocsigen/ocsigen.org-data), copy `tyxml/dev` to the new version number. -- Add the new version in the [download page](http://ocsigen.org/tyxml/install). - -- Publish on opam. diff --git a/_oasis b/_oasis index f187a89..d7281a7 100644 --- a/_oasis +++ b/_oasis @@ -5,7 +5,7 @@ OASISFormat: 0.4 OCamlVersion: >= 4.01 Name: lwt -Version: 2.5.1 +Version: 2.5.2 LicenseFile: COPYING License: LGPL-2.1 with OCaml linking exception Authors: diff --git a/manual/manual.wiki b/manual/manual.wiki index 8b44e8f..28bb270 100644 --- a/manual/manual.wiki +++ b/manual/manual.wiki @@ -367,8 +367,17 @@ lwt () = === The syntax extension === - {{{Lwt}}} offers a syntax extension which increases code readability and - makes coding using {{{Lwt}}} easier. To use it add the {{{lwt.syntax}}} package when + {{{Lwt}}} offers two syntax extensions which increases code readability and + makes coding using {{{Lwt}}} easier. + +==== Ppx ==== + + The Ppx syntax extension is documented <<a_api text="here" | module Ppx_lwt>>. + This syntax extension is more recent and is recommended. + +==== Camlp4 ==== + +To use it add the {{{lwt.syntax}}} package when compiling: <<code language="ocaml" |$ ocamlfind ocamlc -syntax camlp4o -package lwt.syntax -linkpkg -o foo foo.ml @@ -462,15 +471,29 @@ expr === Backtrace support === - When using {{{Lwt}}}, exceptions are not recorded by the ocaml runtime, and so you don't - get backtraces. However it is possible to get them when using the syntax extension. All you - have to do is to pass the {{{-lwt-debug}}} switch to {{{camlp4}}}: + If an exception is raised inside an Lwt thread, the backtrace provided by OCaml + will not be very useful. It will end inside the Lwt scheduler instead of + continuing into the code that started the thread. To avoid this, and get good + backtraces from Lwt, use one of the syntax extensions in debug mode. + + In debug mode, the {{{lwt}}} and {{{let%lwt}}} constructs will properly + propagate backtraces. + + In the <<a_api text="ppx syntax extension" | module Ppx_lwt>>, the debug mode is + enabled by default. This has a small performance impact, so you can disable it + by passing {{{-no-debug}}}. + + In the {{{camlp4 syntax extension}}}, you need to pass the {{{-lwt-debug}}} switch: {{{ $ ocamlfind ocamlc -syntax camlp4o -package lwt.syntax \ -ppopt -lwt-debug -linkpkg -o foo foo.ml }}} + As always, to get backtraces from an OCaml program, you need to either declare + the environment variable {{{OCAMLRUNPARAM=b}}} or call + {{{Printexc.record_backtrace true}}} at the start of your program. + === Other modules of the core library === The core library contains several modules that only depend on diff --git a/ppx/ppx_lwt.mli b/ppx/ppx_lwt.mli index 8ab637a..320fc65 100644 --- a/ppx/ppx_lwt.mli +++ b/ppx/ppx_lwt.mli @@ -25,13 +25,18 @@ (** {2 Ppx extensions} + This Ppx extension adds various syntactic shortcut for lwt programming. + It needs OCaml >= 4.02 and {{:https://github.com/alainfrisch/ppx_tools}ppx_tools}. + + To use it, simply use the ocamlfind package [lwt.ppx]. + This extension adds the following syntax: - lwt-binding: {[ - let%lwt ch = get_char stdin in - code +let%lwt ch = get_char stdin in +code ]} is the same as [bind (get_char stdin) (fun ch -> code)]. @@ -39,50 +44,50 @@ Moreover, it supports parallel binding: {[ - let%lwt x = do_something1 () - and y = do_something2 in - code +let%lwt x = do_something1 () +and y = do_something2 in +code ]} will run [do_something1 ()] and [do_something2 ()], then bind their results to [x] and [y]. It is the same as: {[ - let t1 = do_something1 - and t2 = do_something2 in - bind t1 (fun x -> bind t2 (fun y -> code)) +let t1 = do_something1 +and t2 = do_something2 in +bind t1 (fun x -> bind t2 (fun y -> code)) ]} - exception catching: {[ - try%lwt - <expr> - with - <branches> +try%lwt + <expr> +with + <branches> ]} For example: {[ - try%lwt - f x - with - | Failure msg -> - prerr_endline msg; - return () +try%lwt + f x +with + | Failure msg -> + prerr_endline msg; + return () ]} is expanded to: {[ - catch (fun () -> f x) - (function - | Failure msg -> - prerr_endline msg; - return () - | exn -> - Lwt.fail exn) +catch (fun () -> f x) + (function + | Failure msg -> + prerr_endline msg; + return () + | exn -> + Lwt.fail exn) ]} Note that the [exn -> Lwt.fail exn] branch is automatically added @@ -106,53 +111,53 @@ - for loop: {[ - for%lwt i = <expr> to <expr> do - <expr> - done +for%lwt i = <expr> to <expr> do + <expr> +done ]} and: {[ - for%lwt i = <expr> downto <expr> do - <expr> - done +for%lwt i = <expr> downto <expr> do + <expr> +done ]} - while loop: {[ - while%lwt <expr> do - <expr> - done +while%lwt <expr> do + <expr> +done ]} - pattern matching: {[ - match%lwt <expr> with - | <patt_1> -> <expr_1> - ... - | <patt_n> -> <expr_n> +match%lwt <expr> with + | <patt_1> -> <expr_1> + ... + | <patt_n> -> <expr_n> ]} Exception cases are also supported: {[ - match%lwt <expr> with - | exception <exn> -> <expr_1> - | <patt_2> -> <expr_2> - ... - | <patt_n> -> <expr_n> +match%lwt <expr> with + | exception <exn> -> <expr_1> + | <patt_2> -> <expr_2> + ... + | <patt_n> -> <expr_n> ]} - conditional: {[ - if%lwt <expr> then - <expr_1> - else - <expr_2> +if%lwt <expr> then + <expr_1> +else + <expr_2> ]} and @@ -179,7 +184,12 @@ By default, the debug mode is enabled. This means that the [backtrace] versions of the [bind], [finalize] and [catch] functions are used, enabling proper backtraces for the Lwt exceptions. - The debug mode can be disabled with the option [-no-debug]. + The debug mode can be disabled with the option [-no-debug]: + + {[ +$ ocamlfind ocamlc -package lwt.ppx \ + -ppxopt lwt.ppx,-no-debug -linkpkg -o foo foo.ml + ]} {2 Sequence} @@ -191,7 +201,8 @@ By default, each operation must return [unit Lwt.t]. This constraint can be lifted with the option [-no-strict-sequence]. The operator can be disabled with the option [-no-sequence]. - + Note that unlike [>>=], [>>] is not an OCaml value. it is a piece of syntax + added by the ppx rewriter - i.e., you cannot refer to [(>>)]. {2 Logging} @@ -205,10 +216,10 @@ by {[ - if Lwt_log.Section.level section <= Lwt_log.Info then - Lwt_log.info_f ~section "x = %d" x - else - return () +if Lwt_log.Section.level section <= Lwt_log.Info then + Lwt_log.info_f ~section "x = %d" x +else + return () ]} Notes: diff --git a/ppx/ppx_lwt_ex.ml b/ppx/ppx_lwt_ex.ml index c881760..b6a22ea 100644 --- a/ppx/ppx_lwt_ex.ml +++ b/ppx/ppx_lwt_ex.ml @@ -13,16 +13,19 @@ let with_loc f { txt ; loc } = let def_loc txt = { txt; loc = !default_loc } -(** Test if a pattern is a catchall. *) -let rec is_catchall p = match p.ppat_desc with - | Ppat_any | Ppat_var _ -> true - | Ppat_alias (p, _) -> is_catchall p - | _ -> false +(** Test if a case is a catchall. *) +let is_catchall case = + let rec is_catchall_pat p = match p.ppat_desc with + | Ppat_any | Ppat_var _ -> true + | Ppat_alias (p, _) -> is_catchall_pat p + | _ -> false + in + case.pc_guard = None && is_catchall_pat case.pc_lhs (** Add a wildcard case in there is none. Useful for exception handlers. *) let add_wildcard_case cases = let has_wildcard = - List.exists (fun case -> is_catchall case.pc_lhs) cases + List.exists is_catchall cases in if not has_wildcard then cases @ [Exp.case [%pat? exn] [%expr Lwt.fail exn]] @@ -278,9 +281,9 @@ let lwt_log mapper fn args attrs loc = else if List.mem level ["Fatal"; "Error"; "Warning"; "Notice"; "Info"; "Debug"] then let args = List.map (fun (l,e) -> l, mapper.expr mapper e) args in let new_exp = - let args = ("location", make_loc loc) :: - ("section", [%expr __pa_log_section]) :: - List.remove_assoc "section" args in + let args = (Label.labelled "location", make_loc loc) :: + (Label.labelled "section", [%expr __pa_log_section]) :: + List.remove_assoc (Label.labelled "section") args in [%expr if [%e Exp.construct (def_loc (Ldot (Lident "Lwt_log", level))) None] >= Lwt_log.Section.level __pa_log_section then @@ -289,7 +292,7 @@ let lwt_log mapper fn args attrs loc = [%e if ign then [%expr ()] else [%expr Lwt.return_unit]]] in try - let section = List.assoc "section" args in + let section = List.assoc (Label.labelled "section") args in [%expr let __pa_log_section = [%e section] in [%e new_exp]] with Not_found -> [%expr let __pa_log_section = Lwt_log.Section.main in [%e new_exp]] diff --git a/setup-dev.exe b/setup-dev.exe deleted file mode 100755 index 30b3089..0000000 Binary files a/setup-dev.exe and /dev/null differ diff --git a/setup.ml b/setup.ml index 2aee449..b9fec8a 100644 --- a/setup.ml +++ b/setup.ml @@ -8,7 +8,7 @@ *) (* OASIS_START *) -(* DO NOT EDIT (digest: 4532d086a8e7217dc6b470d957196a13) *) +(* DO NOT EDIT (digest: 13a9c966497f2b6a6f07ba3388dc24a9) *) (* Regenerated by OASIS v0.4.5 Visit http://oasis.forge.ocamlcore.org for more information and @@ -7005,7 +7005,7 @@ let setup_t = alpha_features = ["pure_interface"]; beta_features = []; name = "lwt"; - version = "2.5.1"; + version = "2.5.2"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -8557,7 +8557,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.5"; - oasis_digest = Some "j\145\203\180x\249\224\242\1589X\023J\007]\211"; + oasis_digest = Some "\219\156\247\014n\250\252\159\001!\136\197:E=\223"; oasis_exec = None; oasis_setup_args = []; setup_update = false diff --git a/src/core/META b/src/core/META index f875429..f605719 100644 --- a/src/core/META +++ b/src/core/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: 3c1734eda62f399a1b3f12fec3c7772a) -version = "2.5.1" +# DO NOT EDIT (digest: bc8d6fff062fa1a39ca89d01e9e1c40c) +version = "2.5.2" description = "Lightweight thread library for OCaml (core library)" requires = "bytes" archive(byte) = "lwt.cma" @@ -9,7 +9,7 @@ archive(native) = "lwt.cmxa" archive(native, plugin) = "lwt.cmxs" exists_if = "lwt.cma" package "unix" ( - version = "2.5.1" + version = "2.5.2" description = "Unix support for lwt" requires = "lwt lwt.log unix bigarray" archive(byte) = "lwt-unix.cma" @@ -20,7 +20,7 @@ package "unix" ( ) package "syntax" ( - version = "2.5.1" + version = "2.5.2" description = "Syntactic sugars for Lwt" requires = "camlp4 lwt.syntax.options" archive(syntax, preprocessor) = "lwt-syntax.cma" @@ -29,7 +29,7 @@ package "syntax" ( archive(syntax, preprocessor, native, plugin) = "lwt-syntax.cmxs" exists_if = "lwt-syntax.cma" package "options" ( - version = "2.5.1" + version = "2.5.2" description = "Options for syntax extensions" requires = "camlp4" archive(syntax, preprocessor) = "lwt-syntax-options.cma" @@ -40,7 +40,7 @@ package "syntax" ( ) package "log" ( - version = "2.5.1" + version = "2.5.2" description = "Syntactic sugars for logging" requires = "camlp4 lwt.syntax.options" archive(syntax, preprocessor) = "lwt-syntax-log.cma" @@ -52,7 +52,7 @@ package "syntax" ( ) package "ssl" ( - version = "2.5.1" + version = "2.5.2" description = "SSL support for Lwt" requires = "ssl lwt.unix" archive(byte) = "lwt-ssl.cma" @@ -63,7 +63,7 @@ package "ssl" ( ) package "simple-top" ( - version = "2.5.1" + version = "2.5.2" description = "Unix support for lwt" requires = "lwt lwt.unix compiler-libs.common" archive(byte) = "lwt-simple-top.cma" @@ -74,7 +74,7 @@ package "simple-top" ( ) package "react" ( - version = "2.5.1" + version = "2.5.2" description = "Reactive programming helpers" requires = "lwt react" archive(byte) = "lwt-react.cma" @@ -85,7 +85,7 @@ package "react" ( ) package "preemptive" ( - version = "2.5.1" + version = "2.5.2" description = "Preemptive threads support for Lwt" requires = "lwt lwt.unix threads" archive(byte) = "lwt-preemptive.cma" @@ -96,7 +96,7 @@ package "preemptive" ( ) package "ppx" ( - version = "2.5.1" + version = "2.5.2" description = "New-style (ppx) syntax extension" requires = "lwt" archive(byte) = "ppx.cma" @@ -108,7 +108,7 @@ package "ppx" ( ) package "log" ( - version = "2.5.1" + version = "2.5.2" description = "Logger for lwt" requires = "lwt" archive(byte) = "lwt-log.cma" @@ -119,7 +119,7 @@ package "log" ( ) package "glib" ( - version = "2.5.1" + version = "2.5.2" description = "Glib integration" requires = "lwt lwt.unix" archive(byte) = "lwt-glib.cma" diff --git a/src/core/lwt.mli b/src/core/lwt.mli index 93058bb..58c0e8b 100644 --- a/src/core/lwt.mli +++ b/src/core/lwt.mli @@ -78,7 +78,12 @@ val bind : 'a t -> ('a -> 'b t) -> 'b t Note that [bind] is also often used just for synchronization purpose: [t'] will not execute before [t] is terminated. - The result of a thread can be bound several times. *) + The result of a thread can be bound several times. + + Note that [bind] will not propagate backtraces correctly. + See <<a_api project="lwt" | The manual>> + for how to enable backtraces. + *) val (>>=) : 'a t -> ('a -> 'b t) -> 'b t (** [t >>= f] is an alternative notation for [bind t f]. *) @@ -253,7 +258,11 @@ val async_exception_hook : (exn -> unit) ref backtrace if available and to exit the program. The behavior is undefined if this function raise an - exception. *) + exception. + + See <<a_api project="lwt" | The manual>> + for how to enable backtraces. + *) (** {2 Sleeping and resuming} *) diff --git a/src/core/lwt_stream.ml b/src/core/lwt_stream.ml index 307acee..fafe2d4 100644 --- a/src/core/lwt_stream.ml +++ b/src/core/lwt_stream.ml @@ -326,6 +326,14 @@ class ['a] bounded_push_impl (info : 'a push_bounded) wakener_cell last hooks = info.pushb_pending <- None; Lwt.wakeup_later_exn info.pushb_push_wakener Closed end; + (* Send a signal if at least one thread is waiting for a new + element. *) + if info.pushb_waiting then begin + info.pushb_waiting <- false; + let old_wakener = !wakener_cell in + (* Signal that a new value has been received. *) + Lwt.wakeup_later old_wakener () + end; List.iter (fun f -> f ()) !hooks end @@ -1044,6 +1052,7 @@ let choose streams = streams := source s :: l; Lwt.return x | None -> + streams := l; next () in from next diff --git a/src/unix/lwt_daemon.ml b/src/unix/lwt_daemon.ml index 3824b40..9620545 100644 --- a/src/unix/lwt_daemon.ml +++ b/src/unix/lwt_daemon.ml @@ -48,42 +48,37 @@ let redirect_output dev_null fd mode = match mode with redirect fd (Some logger) let daemonize ?(syslog=true) ?(stdin=`Dev_null) ?(stdout=`Log_default) ?(stderr=`Log_default) ?(directory="/") ?(umask=`Set 0o022) () = - if Unix.getppid () = 1 then - (* If our parent is [init], then we already are a demon *) - () - else begin - Unix.chdir directory; + Unix.chdir directory; - (* Exit the parent, and continue in the child: *) - if Lwt_unix.fork () > 0 then begin - (* Do not run exit hooks in the parent. *) - Lwt_sequence.iter_node_l Lwt_sequence.remove Lwt_main.exit_hooks; - exit 0 - end; + (* Exit the parent, and continue in the child: *) + if Lwt_unix.fork () > 0 then begin + (* Do not run exit hooks in the parent. *) + Lwt_sequence.iter_node_l Lwt_sequence.remove Lwt_main.exit_hooks; + exit 0 + end; - if syslog then Lwt_log.default := Lwt_log.syslog ~facility:`Daemon (); + if syslog then Lwt_log.default := Lwt_log.syslog ~facility:`Daemon (); - (* Redirection of standard IOs *) - let dev_null = Unix.openfile "/dev/null" [Unix.O_RDWR] 0o666 in - begin match stdin with - | `Dev_null -> - Unix.dup2 dev_null Unix.stdin - | `Close -> - Unix.close Unix.stdin - | `Keep -> - () - end; - redirect_output dev_null Unix.stdout stdout; - redirect_output dev_null Unix.stderr stderr; - Unix.close dev_null; + (* Redirection of standard IOs *) + let dev_null = Unix.openfile "/dev/null" [Unix.O_RDWR] 0o666 in + begin match stdin with + | `Dev_null -> + Unix.dup2 dev_null Unix.stdin + | `Close -> + Unix.close Unix.stdin + | `Keep -> + () + end; + redirect_output dev_null Unix.stdout stdout; + redirect_output dev_null Unix.stderr stderr; + Unix.close dev_null; - begin match umask with - | `Keep -> - () - | `Set n -> - ignore (Unix.umask n); - end; + begin match umask with + | `Keep -> + () + | `Set n -> + ignore (Unix.umask n); + end; - ignore (Unix.setsid ()) - end + ignore (Unix.setsid ()) diff --git a/src/unix/lwt_daemon.mli b/src/unix/lwt_daemon.mli index 6cb48ea..2bb2071 100644 --- a/src/unix/lwt_daemon.mli +++ b/src/unix/lwt_daemon.mli @@ -35,7 +35,6 @@ val daemonize : and redict standard intputs/outputs.. Notes: - - if the process is already a daemon, it does nothing. - you must be sure that there is no pending threads when calling this function, otherwise they may be canceled. diff --git a/src/unix/lwt_io.mli b/src/unix/lwt_io.mli index 43092a5..0020e3f 100644 --- a/src/unix/lwt_io.mli +++ b/src/unix/lwt_io.mli @@ -254,7 +254,7 @@ val read_lines : input_channel -> string Lwt_stream.t (** [read_lines ic] returns a stream holding all lines of [ic] *) val read : ?count : int -> input_channel -> string Lwt.t - (** [read ?count ic] reads at most [len] characters from [ic]. It + (** [read ?count ic] reads at most [count] characters from [ic]. It returns [""] if the end of input is reached. If [count] is not specified, it reads all bytes until the end of input. *) diff --git a/src/unix/lwt_process.ml b/src/unix/lwt_process.ml index 9466aa4..f7afb25 100644 --- a/src/unix/lwt_process.ml +++ b/src/unix/lwt_process.ml @@ -196,8 +196,8 @@ let ignore_close chan = ignore (Lwt_io.close chan) class virtual common timeout proc channels = let wait = waitproc proc in - let close = lazy(Lwt.join (List.map Lwt_io.close channels) >>= fun () -> wait) in object(self) + val mutable closed = false method pid = proc.id @@ -214,7 +214,13 @@ object(self) if Lwt.state wait = Lwt.Sleep then terminate proc - method close = Lwt.protected (Lazy.force close) >|= status + method close = + if closed then self#status + else ( + closed <- true; + Lwt.protected (Lwt.join (List.map Lwt_io.close channels)) + >>= fun () -> self#status + ) method status = Lwt.protected wait >|= status method rusage = Lwt.protected wait >|= rusage @@ -238,7 +244,7 @@ object(self) Lwt.return_unit | false -> self#terminate; - Lazy.force close >>= fun _ -> Lwt.return_unit) + self#close >>= fun _ -> Lwt.return_unit) (fun exn -> (* The exception is dropped because it can be obtained with self#close. *) diff --git a/src/unix/lwt_unix.mli b/src/unix/lwt_unix.mli index 91d716e..7d1b476 100644 --- a/src/unix/lwt_unix.mli +++ b/src/unix/lwt_unix.mli @@ -110,7 +110,7 @@ val with_async_none : (unit -> 'a) -> 'a *) val with_async_detach : (unit -> 'a) -> 'a - (** [with_async_none f] is a shorthand for: + (** [with_async_detach f] is a shorthand for: {[ Lwt.with_value async_method_key (Some Async_detach) f @@ -118,7 +118,7 @@ val with_async_detach : (unit -> 'a) -> 'a *) val with_async_switch : (unit -> 'a) -> 'a - (** [with_async_none f] is a shorthand for: + (** [with_async_switch f] is a shorthand for: {[ Lwt.with_value async_method_key (Some Async_switch) f diff --git a/src/unix/lwt_unix_unix.c b/src/unix/lwt_unix_unix.c index cc05c12..ba2e589 100644 --- a/src/unix/lwt_unix_unix.c +++ b/src/unix/lwt_unix_unix.c @@ -55,7 +55,7 @@ CAMLprim value lwt_unix_writable(value fd) pollfd.events = POLLOUT; pollfd.revents = 0; if (poll(&pollfd, 1, 0) < 0) - uerror("readable", Nothing); + uerror("writable", Nothing); return (Val_bool(pollfd.revents & POLLOUT)); } diff --git a/tests/META b/tests/META index 3ba362d..50fbfbd 100644 --- a/tests/META +++ b/tests/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: 7d45969588e64211e57bd2f56402e4f7) -version = "2.5.1" +# DO NOT EDIT (digest: f4d8512d6f7aadc1a86f911e1462aeef) +version = "2.5.2" description = "Lightweight thread library for OCaml" requires = "lwt unix lwt.unix" archive(byte) = "test.cma" diff --git a/tests/core/test_lwt_stream.ml b/tests/core/test_lwt_stream.ml index c7367aa..369f3d5 100644 --- a/tests/core/test_lwt_stream.ml +++ b/tests/core/test_lwt_stream.ml @@ -109,6 +109,19 @@ let suite = suite "lwt_stream" [ let acc = acc && state (Lwt_stream.to_list stream) = Return [3; 4; 7] in return acc); + test "create_bounded close" + (fun () -> + let stream, push = Lwt_stream.create_bounded 1 in + let acc = true in + let acc = acc && state (push#push 1) = Return () in + let iter_delayed = Lwt_stream.to_list stream in + Lwt_unix.yield () >>= fun () -> + push#close; + Lwt_unix.yield () >>= fun () -> + let acc = acc && state iter_delayed = Return [1] in + return acc + ); + test "get_while" (fun () -> let stream = Lwt_stream.of_list [1; 2; 3; 4; 5] in @@ -293,4 +306,8 @@ let suite = suite "lwt_stream" [ ignore (Lwt_stream.peek st); let b3 = !b = true in Lwt.return (b1 && b2 && b3)); + + test "choose_exhausted" + (fun () -> + Lwt_stream.(to_list (choose [of_list []])) >|= fun _ -> true); ] diff --git a/tests/unix/main.ml b/tests/unix/main.ml index f37de8b..0ac98cd 100644 --- a/tests/unix/main.ml +++ b/tests/unix/main.ml @@ -23,5 +23,6 @@ Test.run "unix" [ Test_lwt_io.suite; Test_lwt_io_non_block.suite; + Test_lwt_process.suite; Test_mcast.suite; ] diff --git a/tests/unix/test_lwt_process.ml b/tests/unix/test_lwt_process.ml new file mode 100644 index 0000000..eefe08f --- /dev/null +++ b/tests/unix/test_lwt_process.ml @@ -0,0 +1,16 @@ + +open Lwt +open Lwt_io +open Test + +let suite = suite "lwt_process" [ + test "lazy_undefined" + (fun () -> + Lwt_process.with_process_in + ~timeout:1. ("sleep", [| "sleep"; "2" |]) + (fun p -> + Lwt.catch + (fun () -> Lwt_io.read p#stdout) + (fun _ -> Lwt.return "")) + >>= fun _ -> Lwt.return_true) +] -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/lwt.git _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits