[Pkg-ocaml-maint-commits] [lwt] 02/12: Imported Upstream version 2.5.2
Stéphane Glondu
glondu at moszumanska.debian.org
Thu Jul 28 08:51:42 UTC 2016
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 <steph at 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
More information about the Pkg-ocaml-maint-commits
mailing list