[Pkg-ocaml-maint-commits] [lwt] 04/11: New upstream version 2.7.1
Stéphane Glondu
glondu at moszumanska.debian.org
Wed Jul 26 12:42:37 UTC 2017
This is an automated email from the git hooks/post-receive script.
glondu pushed a commit to branch master
in repository lwt.
commit 372d142e8b481ce7cf6ced6664c451d5bfa872c1
Author: Stephane Glondu <steph at glondu.net>
Date: Wed Jul 26 07:15:28 2017 +0200
New upstream version 2.7.1
---
CHANGES | 14 ++
Makefile | 15 +-
README.md | 11 +-
_tags | 4 +
lwt.opam | 13 +-
myocamlbuild.ml | 152 +++++++++++----------
setup.ml | 26 +++-
src/core/META | 26 ++--
src/core/lwt_result.mli | 2 -
src/unix/lwt_bytes.ml | 5 +
src/unix/lwt_main.mli | 2 +-
src/unix/{lwt_unix.ml => lwt_unix.cppo.ml} | 13 +-
src/unix/{lwt_unix.mli => lwt_unix.cppo.mli} | 31 ++++-
src/unix/lwt_unix_unix.c | 48 ++++---
src/util/discover.ml | 33 +++++
src/util/lwt.install | 6 +
tests/META | 4 +-
tests/unix/main.ml | 38 ++++--
tests/unix/test_lwt_io_non_block.ml | 18 +++
.../{test_lwt_unix.ml => test_lwt_unix.cppo.ml} | 44 +++++-
20 files changed, 369 insertions(+), 136 deletions(-)
diff --git a/CHANGES b/CHANGES
index e8de371..98da732 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,17 @@
+===== 2.7.1 (2017-04-08) =====
+
+====== Fixes ======
+
+ * OCaml 4.05 compatibility (Mauricio Fernandez, #322).
+ * Give Lwt_unix.file_exists the same semantics as Sys.file_exists, with
+ respect to not raising Unix.Unix_error (Mauricio Fernandez, #316).
+ * Improve diagnostics from build scripts (Tim Cuthbertson, #313, #314).
+
+====== Additions ======
+
+ * Announce Lwt_result, which was originally released as an experimental module
+ in release 2.6.0 (Simon Cruanes, #320, #247).
+
===== 2.7.0 (2017-01-03) =====
====== General ======
diff --git a/Makefile b/Makefile
index 94f5e77..566ae1c 100644
--- a/Makefile
+++ b/Makefile
@@ -38,7 +38,7 @@ doc: $(SETUP) setup.data build
doc-api: $(SETUP) setup.data build
./$(SETUP) -build lwt-api.docdir/index.html
-test: $(SETUP) setup.data build
+test: $(SETUP) setup.data build clean-coverage
./$(SETUP) -test $(TESTFLAGS)
all: $(SETUP)
@@ -53,17 +53,26 @@ uninstall: $(SETUP) setup.data
reinstall: $(SETUP) setup.data
./$(SETUP) -reinstall $(REINSTALLFLAGS)
-clean: $(SETUP)
+clean: $(SETUP) clean-coverage
./$(SETUP) -clean $(CLEANFLAGS)
distclean: $(SETUP)
./$(SETUP) -distclean $(DISTCLEANFLAGS)
rm -rf setup*.exe
+clean-coverage:
+ rm -rf bisect*.out
+ rm -rf _coverage/
+
configure: $(SETUP)
./$(SETUP) -configure $(CONFIGUREFLAGS)
setup.data: $(SETUP)
./$(SETUP) -configure $(CONFIGUREFLAGS)
-.PHONY: default setup build doc test all install uninstall reinstall clean distclean configure
+coverage: test
+ bisect-ppx-report -I _build/ -html _coverage/ bisect*.out
+ bisect-ppx-report -text - -summary-only bisect*.out
+ @echo See _coverage/index.html
+
+.PHONY: default setup build doc test all install uninstall reinstall clean distclean configure coverage
diff --git a/README.md b/README.md
index 6a3da19..8e51e2f 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,6 @@
-# Lwt [![version 2.7.0][version]][releases] [![LGPL][license-img]][copying] [![Gitter chat][gitter-img]][gitter] [![Travis status][travis-img]][travis] [![AppVeyor status][appveyor-img]][appveyor]
+# Lwt [![version 2.7.1][version]][releases] [![LGPL][license-img]][copying] [![Gitter chat][gitter-img]][gitter] [![Travis status][travis-img]][travis] [![AppVeyor status][appveyor-img]][appveyor]
-[version]: https://img.shields.io/badge/version-2.7.0-blue.svg
+[version]: https://img.shields.io/badge/version-2.7.1-blue.svg
[releases]: https://github.com/ocsigen/lwt/releases
[license-img]: https://img.shields.io/badge/license-LGPL-blue.svg
[gitter-img]: https://img.shields.io/badge/chat-on_gitter-lightgrey.svg
@@ -86,11 +86,18 @@ Open an [issue][issues], visit [Gitter][gitter] chat, [email][email] the
maintainer, or ask in [#ocaml][irc]. If you think enough people will be
interested in the answer, it is also possible to ask on [Stack Overflow][so].
+Subscribe to the [announcements issue][announcements] to get news about Lwt
+releases. It is less noisy than watching the whole repository. Announcements are
+also made in [/r/ocaml][reddit] and on the [OCaml mailing list][caml-list].
+
[issues]: https://github.com/ocsigen/lwt/issues/new
[gitter]: https://gitter.im/ocaml-lwt/Lobby
[email]: mailto:antonbachin at yahoo.com
[irc]: http://webchat.freenode.net/?channels=#ocaml
[so]: http://stackoverflow.com/questions/ask?tags=ocaml,lwt,ocaml-lwt
+[announcements]: https://github.com/ocsigen/lwt/issues/309
+[reddit]: https://www.reddit.com/r/ocaml/
+[caml-list]: https://sympa.inria.fr/sympa/arc/caml-list
<br/>
diff --git a/_tags b/_tags
index b760d2a..fbae8ec 100644
--- a/_tags
+++ b/_tags
@@ -1,6 +1,10 @@
# -*- conf -*-
not <src/ssl/*>: safe_string
+# cppo pre-processing for OCaml (compiler/stdlib) compatibility workarounds
+<**/*.ml>: cppo_V_OCAML
+<**/*.mli>: cppo_V_OCAML
+
# Warnings. The order is important. This is not fully legitimate as it appears
# to depend on how Ocamlbuild internally handles lists of warn() tags.
<src/camlp4/*.ml> or <src/ppx/*.ml>: warn(-4)
diff --git a/lwt.opam b/lwt.opam
index c8913cb..cd40df5 100644
--- a/lwt.opam
+++ b/lwt.opam
@@ -1,7 +1,11 @@
opam-version: "1.2"
name: "lwt"
-version: "2.7.0"
-maintainer: "Anton Bachin <antonbachin at yahoo.com>"
+version: "2.7.1"
+maintainer: [
+ "Anton Bachin <antonbachin at yahoo.com>"
+ "Mauricio Fernandez <mfp at acm.org>"
+ "Simon Cruanes <simon.cruanes.2007 at m4x.org>"
+]
authors: [
"Jérôme Vouillon"
"Jérémie Dimino"
@@ -35,6 +39,7 @@ depends: [
"ocamlfind" {build & >= "1.5.0"}
"ocamlbuild" {build}
"result"
+ "cppo" {build}
# See https://github.com/ocsigen/lwt/issues/266
( "base-no-ppx" | "ppx_tools" {build} )
]
@@ -61,7 +66,3 @@ messages: [
"For module Lwt_react, please install package lwt_react"
{react:installed & !lwt_react:installed}
]
-post-messages: [
- "The future Lwt 3.0.0 will make minor breaking changes near 1 April 2017. See
- https://github.com/ocsigen/lwt/issues/308"
-]
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
index 7c20152..0b8b171 100644
--- a/myocamlbuild.ml
+++ b/myocamlbuild.ml
@@ -1041,18 +1041,27 @@ let define_c_library name env =
if BaseEnvLight.var_get name env = "true" then begin
let tag = c_library_tag name in
- let opt = List.map (fun x -> A x) (split (BaseEnvLight.var_get (name ^ "_opt") env))
- and lib = List.map (fun x -> A x) (split (BaseEnvLight.var_get (name ^ "_lib") env)) in
+ let opt =
+ List.map
+ (fun x -> A x)
+ (split (BaseEnvLight.var_get (name ^ "_opt") env))
+ and lib =
+ List.map
+ (fun x -> A x)
+ (split (BaseEnvLight.var_get (name ^ "_lib") env))
+ in
(* Add flags for linking with the C library: *)
flag ["ocamlmklib"; "c"; tag] & S lib;
(* C stubs using the C library must be compiled with the library
specifics flags: *)
- flag ["c"; "compile"; tag] & S (List.map (fun arg -> S[A"-ccopt"; arg]) opt);
+ flag ["c"; "compile"; tag] &
+ S (List.map (fun arg -> S[A"-ccopt"; arg]) opt);
(* OCaml libraries must depends on the C library: *)
- flag ["link"; "ocaml"; tag] & S (List.map (fun arg -> S[A"-cclib"; arg]) lib)
+ flag ["link"; "ocaml"; tag] &
+ S (List.map (fun arg -> S[A"-cclib"; arg]) lib)
end
let conditional_warnings_as_errors () =
@@ -1061,78 +1070,75 @@ let conditional_warnings_as_errors () =
let flags = S [A "-warn-error"; A "+A"] in
flag ["ocaml"; "compile"] flags;
flag ["ocaml"; "link"] flags
-
| _ -> ()
| exception Not_found -> ()
-let () =
- dispatch
- (fun hook ->
- dispatch_default hook;
- match hook with
- | Before_options ->
- Options.make_links := false
-
- | After_rules ->
- let env =
- BaseEnvLight.load
- ~allow_empty:true
- ~filename:(Pathname.basename BaseEnvLight.default_filename)
- ()
- in
-
- (* Determine extension of CompiledObject: best *)
- let native_suffix =
- if BaseEnvLight.var_get "is_native" env = "true"
- then "native" else "byte"
- in
-
- (* Internal syntax extension *)
- List.iter
- (fun base ->
- let tag = "pa_" ^ base and file = "src/camlp4/pa_" ^ base ^ ".cmo" in
- flag ["ocaml"; "compile"; tag] & S[A"-ppopt"; A file];
- flag ["ocaml"; "ocamldep"; tag] & S[A"-ppopt"; A file];
- flag ["ocaml"; "doc"; tag] & S[A"-ppopt"; A file];
- dep ["ocaml"; "ocamldep"; tag] [file])
- ["lwt_options"; "lwt"; "lwt_log"];
-
- flag ["ocaml"; "compile"; "ppx_lwt"] &
- S [A "-ppx"; A ("src/ppx/ppx_lwt_ex." ^ native_suffix)];
-
- (* Use an introduction page with categories *)
- tag_file "lwt-api.docdir/index.html" ["apiref"];
- dep ["apiref"] ["doc/apiref-intro"];
- flag ["apiref"] & S[A "-intro"; P "doc/apiref-intro"; A"-colorize-code"];
-
- (* Stubs: *)
- dep ["file:src/unix/lwt_unix_stubs.c"] ["src/unix/lwt_unix_unix.c"; "src/unix/lwt_unix_windows.c"];
-
- (* Check for "unix" because other variables are not
- present in the setup.data file if lwt.unix is
- disabled. *)
- let c_libraries = ["glib"; "libev"; "pthread"] in
-
- if BaseEnvLight.var_get "unix" env = "true" then begin
- List.iter (fun name -> define_c_library name env) c_libraries;
- flag ["c"; "compile"; "use_lwt_headers"] & S [A"-ccopt"; A"-Isrc/unix"];
- end;
-
- List.iter (fun name ->
- mark_tag_used (c_library_tag name)) c_libraries;
-
- conditional_warnings_as_errors ()
-
- | _ ->
- ())
+let () = dispatch begin fun hook ->
+ let env =
+ BaseEnvLight.load
+ ~allow_empty:true
+ ~filename:(Pathname.basename BaseEnvLight.default_filename)
+ ()
+ in
-(* Compile the wiki version of the Ocamldoc.
+ Ocamlbuild_cppo.dispatcher hook;
- Thanks to Till Varoquaux on usenet:
- http://www.digipedia.pl/usenet/thread/14273/231/
+ dispatch_default hook;
+
+ match hook with
+ | Before_options ->
+ Options.make_links := false
+
+ | After_options ->
+ if BaseEnvLight.var_get "coverage" env = "true" then
+ Options.tag_lines :=
+ ["<src/**>: package(bisect_ppx)";
+ "<**/lwt_config.*>: -package(bisect_ppx)";
+ "<tests/**/*.native> or <tests/**/*.byte>: package(bisect_ppx)";
+ "<doc/examples/**>: package(bisect_ppx)"]
+ @ !Options.tag_lines
+
+ | After_rules ->
+ (* Determine extension of CompiledObject: best *)
+ let native_suffix =
+ if BaseEnvLight.var_get "is_native" env = "true"
+ then "native" else "byte"
+ in
+
+ flag ["ocaml"; "compile"; "ppx_lwt"] &
+ S [A "-ppx"; A ("src/ppx/ppx_lwt_ex." ^ native_suffix)];
-*)
+ (* Use an introduction page with categories *)
+ tag_file "lwt-api.docdir/index.html" ["apiref"];
+ dep ["apiref"] ["doc/apiref-intro"];
+ flag ["apiref"] & S[A "-intro"; P "doc/apiref-intro"; A"-colorize-code"];
+ (* Stubs: *)
+ dep ["file:src/unix/lwt_unix_stubs.c"]
+ ["src/unix/lwt_unix_unix.c"; "src/unix/lwt_unix_windows.c"];
+
+ let c_libraries = ["glib"; "libev"; "pthread"] in
+
+ (* Check for "unix" because other variables are not present in the
+ setup.data file if lwt.unix is disabled. *)
+ if BaseEnvLight.var_get "unix" env = "true" then begin
+ List.iter (fun name -> define_c_library name env) c_libraries;
+ flag ["c"; "compile"; "use_lwt_headers"] & S [A"-ccopt"; A"-Isrc/unix"];
+ end;
+
+ List.iter (fun name ->
+ mark_tag_used (c_library_tag name)) c_libraries;
+
+ conditional_warnings_as_errors ();
+
+ | _ ->
+ ()
+ end
+
+(* Compile the wiki version of the Ocamldoc.
+
+ Thanks to Till Varoquaux on usenet:
+ http://www.digipedia.pl/usenet/thread/14273/231/ *)
let ocamldoc_wiki tags deps docout docdir =
let tags = tags -- "extension:html" in
Ocamlbuild_pack.Ocaml_tools.ocamldoc_l_dir tags deps docout docdir
@@ -1140,7 +1146,10 @@ let ocamldoc_wiki tags deps docout docdir =
let () =
try
let wikidoc_dir =
- let base = Ocamlbuild_pack.My_unix.run_and_read "ocamlfind query wikidoc 2> /dev/null" in
+ let base =
+ Ocamlbuild_pack.My_unix.run_and_read
+ "ocamlfind query wikidoc 2> /dev/null"
+ in
String.sub base 0 (String.length base - 1)
in
@@ -1157,4 +1166,5 @@ let () =
tag_file "lwt-api.wikidocdir/index.wiki" ["apiref";"wikidoc"];
flag ["wikidoc"] & S[A"-i";A wikidoc_dir;A"-g";A"odoc_wiki.cma"]
- with Failure e -> () (* Silently fail if the package wikidoc isn't available *)
+ (* Silently fail if the package wikidoc isn't available *)
+ with Failure e -> ()
diff --git a/setup.ml b/setup.ml
index 4098991..50f5804 100644
--- a/setup.ml
+++ b/setup.ml
@@ -8,7 +8,7 @@
*)
(* OASIS_START *)
-(* DO NOT EDIT (digest: 6a3803336de7da9e23d4098c7a0c68f7) *)
+(* DO NOT EDIT (digest: 4e5ca25983a0902e744a79544d5c7868) *)
(*
Regenerated by OASIS v0.4.8
Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6989,7 +6989,9 @@ open OASISTypes;;
let setup_t =
{
BaseSetup.configure = InternalConfigurePlugin.configure;
- build = OCamlbuildPlugin.build ["-use-ocamlfind"];
+ build =
+ OCamlbuildPlugin.build
+ ["-use-ocamlfind"; "-plugin-tags"; "'package(cppo_ocamlbuild)'"];
test =
[
("core",
@@ -7146,7 +7148,7 @@ let setup_t =
{
oasis_version = "0.4";
ocaml_version = Some (OASISVersion.VGreaterEqual "4.02");
- version = "2.7.0";
+ version = "2.7.1";
license =
OASISLicense.DEP5License
(OASISLicense.DEP5Unit
@@ -7156,7 +7158,7 @@ let setup_t =
version = OASISLicense.Version "2.1"
});
findlib_version = None;
- alpha_features = ["pure_interface"];
+ alpha_features = ["pure_interface"; "ocamlbuild_more_args"];
beta_features = [];
name = "lwt";
license_file = Some "COPYING";
@@ -7373,6 +7375,17 @@ let setup_t =
true)
]
});
+ Flag
+ ({
+ cs_name = "coverage";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ flag_description =
+ Some "Instrument for coverage analysis";
+ flag_default = [(OASISExpr.EBool true, false)]
+ });
Library
({
cs_name = "lwt";
@@ -11124,7 +11137,8 @@ let setup_t =
};
oasis_fn = Some "_oasis";
oasis_version = "0.4.8";
- oasis_digest = Some "\234\\z\141(\226\224\128\007=\223L\201o\"\214";
+ oasis_digest =
+ Some "\137\195\141\225\200\147\219O\204\200\146\157+q\2262";
oasis_exec = None;
oasis_setup_args = [];
setup_update = false
@@ -11132,7 +11146,7 @@ let setup_t =
let setup () = BaseSetup.setup setup_t;;
-# 11129 "setup.ml"
+# 11143 "setup.ml"
let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t
open BaseCompat.Compat_0_4
(* OASIS_STOP *)
diff --git a/src/core/META b/src/core/META
index c28658b..676f7de 100644
--- a/src/core/META
+++ b/src/core/META
@@ -1,6 +1,6 @@
# OASIS_START
-# DO NOT EDIT (digest: c92f4f254e34c31c5ea2922a78395deb)
-version = "2.7.0"
+# DO NOT EDIT (digest: f2e19fa63a1ba0bd66190a0d73d1b146)
+version = "2.7.1"
description = "Lightweight thread library for OCaml (core library)"
requires = "bytes result"
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.7.0"
+ version = "2.7.1"
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.7.0"
+ version = "2.7.1"
description = "Camlp4 syntax for Lwt (deprecated; use lwt.ppx)"
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.7.0"
+ version = "2.7.1"
description =
"Options for Lwt Camlp4 syntax extension (deprecated; use lwt.ppx)"
requires = "camlp4"
@@ -41,7 +41,7 @@ package "syntax" (
)
package "log" (
- version = "2.7.0"
+ version = "2.7.1"
description = "Camlp4 syntax for Lwt logging (deprecated; use lwt.ppx)"
requires = "camlp4 lwt.syntax.options"
archive(syntax, preprocessor) = "lwt-syntax-log.cma"
@@ -53,7 +53,7 @@ package "syntax" (
)
package "ssl" (
- version = "2.7.0"
+ version = "2.7.1"
description = "SSL support for Lwt (deprecated; use package lwt_ssl)"
requires = "ssl lwt.unix"
archive(byte) = "lwt-ssl.cma"
@@ -64,7 +64,7 @@ package "ssl" (
)
package "simple-top" (
- version = "2.7.0"
+ version = "2.7.1"
description = "Lwt-OCaml top level integration (deprecated; use utop)"
requires = "lwt lwt.unix compiler-libs.common"
archive(byte) = "lwt-simple-top.cma"
@@ -75,7 +75,7 @@ package "simple-top" (
)
package "react" (
- version = "2.7.0"
+ version = "2.7.1"
description =
"Reactive programming helpers for Lwt (deprecated; use package lwt_react)"
requires = "lwt react"
@@ -87,7 +87,7 @@ package "react" (
)
package "preemptive" (
- version = "2.7.0"
+ version = "2.7.1"
description = "Preemptive thread support for Lwt"
requires = "lwt lwt.unix threads"
archive(byte) = "lwt-preemptive.cma"
@@ -98,7 +98,7 @@ package "preemptive" (
)
package "ppx" (
- version = "2.7.0"
+ version = "2.7.1"
description = "Lwt PPX syntax extension"
requires = "lwt"
archive(byte) = "ppx.cma"
@@ -110,7 +110,7 @@ package "ppx" (
)
package "log" (
- version = "2.7.0"
+ version = "2.7.1"
description = "Logger for Lwt"
requires = "lwt"
archive(byte) = "lwt-log.cma"
@@ -121,7 +121,7 @@ package "log" (
)
package "glib" (
- version = "2.7.0"
+ version = "2.7.1"
description = "GLib integration for Lwt (deprecated; use package lwt_glib)"
requires = "lwt lwt.unix"
archive(byte) = "lwt-glib.cma"
diff --git a/src/core/lwt_result.mli b/src/core/lwt_result.mli
index 92a29b9..373b900 100644
--- a/src/core/lwt_result.mli
+++ b/src/core/lwt_result.mli
@@ -25,8 +25,6 @@
(** This module provides helpers for values of type [('a, 'b) result Lwt.t].
The module is experimental and may change in the future. *)
-[@@@ocaml.deprecated " This module will be removed in the future."]
-
type (+'a, +'b) t = ('a, 'b) Result.result Lwt.t
val return : 'a -> ('a, _) t
diff --git a/src/unix/lwt_bytes.ml b/src/unix/lwt_bytes.ml
index 551e0ab..082febb 100644
--- a/src/unix/lwt_bytes.ml
+++ b/src/unix/lwt_bytes.ml
@@ -224,6 +224,11 @@ let sendto fd buf pos len flags addr =
let map_file ~fd ?pos ~shared ?(size=(-1)) () =
Array1.map_file fd ?pos char c_layout shared size
+ [@@ocaml.warning "-3"]
+ (* BigArray.Array1.map_file is deprecated in OCaml 4.05; however, the
+ suggested replacement requires 4.05 (Lwt still supports 4.02). The
+ replacement also has slighty different exception semantics; see
+ deprecation warning on BigArray.Array1.map_file. *)
[@@@ocaml.warning "-3"]
external mapped : t -> bool = "lwt_unix_mapped" "noalloc"
diff --git a/src/unix/lwt_main.mli b/src/unix/lwt_main.mli
index acbe0a2..097cb50 100644
--- a/src/unix/lwt_main.mli
+++ b/src/unix/lwt_main.mli
@@ -26,7 +26,7 @@
val run : 'a Lwt.t -> 'a
(** [run t] calls the Lwt scheduler repeatedly until [t] terminates,
- then returns the value returned by the thread. It [t] fails with
+ then returns the value returned by the thread. If [t] fails with
an exception, this exception is raised.
Note that you should avoid using [run] inside threads
diff --git a/src/unix/lwt_unix.ml b/src/unix/lwt_unix.cppo.ml
similarity index 99%
rename from src/unix/lwt_unix.ml
rename to src/unix/lwt_unix.cppo.ml
index a22b4d8..b668a88 100644
--- a/src/unix/lwt_unix.ml
+++ b/src/unix/lwt_unix.cppo.ml
@@ -594,6 +594,9 @@ type open_flag =
| O_RSYNC
| O_SHARE_DELETE
| O_CLOEXEC
+#if OCAML_VERSION >= (4, 05, 0)
+ | O_KEEPEXEC
+#endif
external open_job : string -> Unix.open_flag list -> int -> (Unix.file_descr * bool) job = "lwt_unix_open_job"
@@ -906,7 +909,7 @@ let file_exists name =
(fun _ -> Lwt.return_true)
(fun e ->
match e with
- | Unix.Unix_error (Unix.ENOENT, _, _) -> Lwt.return_false
+ | Unix.Unix_error _ -> Lwt.return_false
| _ -> Lwt.fail e) [@ocaml.warning "-4"]
external utimes_job : string -> float -> float -> unit job =
@@ -1002,7 +1005,7 @@ struct
(fun _ -> Lwt.return_true)
(fun e ->
match e with
- | Unix.Unix_error (Unix.ENOENT, _, _) -> Lwt.return_false
+ | Unix.Unix_error _ -> Lwt.return_false
| _ -> Lwt.fail e) [@ocaml.warning "-4"]
end
@@ -1516,7 +1519,13 @@ let shutdown ch shutdown_command =
external stub_socketpair : socket_domain -> socket_type -> int -> Unix.file_descr * Unix.file_descr = "lwt_unix_socketpair_stub"
let socketpair dom typ proto =
+#if OCAML_VERSION >= (4, 05, 0)
+ let do_socketpair =
+ if Sys.win32 then stub_socketpair
+ else Unix.socketpair ?cloexec:None in
+#else
let do_socketpair = if Sys.win32 then stub_socketpair else Unix.socketpair in
+#endif
let (s1, s2) = do_socketpair dom typ proto in
(mk_ch ~blocking:false s1, mk_ch ~blocking:false s2)
diff --git a/src/unix/lwt_unix.mli b/src/unix/lwt_unix.cppo.mli
similarity index 97%
rename from src/unix/lwt_unix.mli
rename to src/unix/lwt_unix.cppo.mli
index 0efe726..337c1a7 100644
--- a/src/unix/lwt_unix.mli
+++ b/src/unix/lwt_unix.cppo.mli
@@ -338,6 +338,9 @@ type open_flag =
| O_RSYNC
| O_SHARE_DELETE
| O_CLOEXEC
+#if OCAML_VERSION >= (4, 05, 0)
+ | O_KEEPEXEC
+#endif
val openfile : string -> open_flag list -> file_perm -> file_descr Lwt.t
(** Wrapper for [Unix.openfile]. *)
@@ -570,7 +573,19 @@ val fstat : file_descr -> stats Lwt.t
(** Wrapper for [Unix.fstat] *)
val file_exists : string -> bool Lwt.t
- (** [file_exists name] tests if a file named [name] exists. *)
+ (** [file_exists name] tests if a file named [name] exists.
+
+ Note that [file_exists] behaves similarly to
+ {{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Sys.html#VALfile_exists}
+ [Sys.file_exists]}:
+
+ - "file" is interpreted as "directory entry" in this context
+
+ - [file_exists name] will return [false] in
+ circumstances that would make {!stat} raise a
+ {{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Unix.html#EXCEPTIONUnix_error}
+ [Unix.Unix_error]} exception.
+ *)
val utimes : string -> float -> float -> unit Lwt.t
(** [utimes path atime mtime] updates the access and modification times of the
@@ -626,7 +641,19 @@ module LargeFile : sig
(** Wrapper for [Unix.LargeFile.fstat] *)
val file_exists : string -> bool Lwt.t
- (** [file_exists name] tests if a file named [name] exists. *)
+ (** [file_exists name] tests if a file named [name] exists.
+
+ Note that [file_exists] behaves similarly to
+ {{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Sys.html#VALfile_exists}
+ [Sys.file_exists]}:
+
+ - "file" is interpreted as "directory entry" in this context
+
+ - [file_exists name] will return [false] in
+ circumstances that would make {!stat} raise a
+ {{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Unix.html#EXCEPTIONUnix_error}
+ [Unix.Unix_error]} exception.
+ *)
end
(** {2 Operations on file names} *)
diff --git a/src/unix/lwt_unix_unix.c b/src/unix/lwt_unix_unix.c
index d2ba916..de1857f 100644
--- a/src/unix/lwt_unix_unix.c
+++ b/src/unix/lwt_unix_unix.c
@@ -26,6 +26,8 @@
#define ARGS(args...) args
+#include <caml/version.h>
+#include <caml/unixsupport.h>
#include <sys/uio.h>
#include <sys/un.h>
#include <sys/time.h>
@@ -1123,29 +1125,25 @@ static int open_flag_table[] = {
O_DSYNC,
O_SYNC,
O_RSYNC,
- 0,
-#ifdef O_CLOEXEC
- O_CLOEXEC
-#else
-#define NEED_CLOEXEC_EMULATION
- 0
-#endif
+ 0, /* O_SHARE_DELETE, Windows-only */
+ 0, /* O_CLOEXEC, treated specially */
+ 0 /* O_KEEPEXEC, treated specially */
};
-#ifdef NEED_CLOEXEC_EMULATION
-static int open_cloexec_table[14] = {
+enum { CLOEXEC = 1, KEEPEXEC = 2 };
+
+static int open_cloexec_table[15] = {
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0,
0,
- 1
+ CLOEXEC, KEEPEXEC
};
-#endif
struct job_open {
struct lwt_unix_job job;
int flags;
int perms;
- int fd;
+ int fd; /* will have value CLOEXEC or KEEPEXEC on entry to worker_open */
int blocking;
int error_code;
char *name;
@@ -1155,10 +1153,28 @@ struct job_open {
static void worker_open(struct job_open *job)
{
int fd;
+ int cloexec;
+
+ if (job->fd & CLOEXEC)
+ cloexec = 1;
+ else if (job->fd & KEEPEXEC)
+ cloexec = 0;
+ else
+#if OCAML_VERSION_MAJOR >= 4 && OCAML_VERSION_MINOR >= 5
+ cloexec = unix_cloexec_default;
+#else
+ cloexec = 0;
+#endif
+
+#if defined(O_CLOEXEC)
+ if (cloexec) job->flags |= O_CLOEXEC;
+#endif
+
fd = open(job->name, job->flags, job->perms);
-#if defined(NEED_CLOEXEC_EMULATION) && defined(FD_CLOEXEC)
- if (fd >= 0 && job->fd) {
+#if !defined(O_CLOEXEC) && defined(FD_CLOEXEC)
+ if (fd >= 0 && cloexec) {
int flags = fcntl(fd, F_GETFD, 0);
+
if (flags == -1 ||
fcntl(fd, F_SETFD, flags | FD_CLOEXEC) == -1) {
int serrno = errno;
@@ -1193,9 +1209,7 @@ static value result_open(struct job_open *job)
CAMLprim value lwt_unix_open_job(value name, value flags, value perms)
{
LWT_UNIX_INIT_JOB_STRING(job, open, 0, name);
-#ifdef NEED_CLOEXEC_EMULATION
- job->fd = caml_convert_flag_list(flags, open_cloexec_table) != 0;
-#endif
+ job->fd = caml_convert_flag_list(flags, open_cloexec_table);
job->flags = caml_convert_flag_list(flags, open_flag_table);
job->perms = Int_val(perms);
return lwt_unix_alloc_job(&(job->job));
diff --git a/src/util/discover.ml b/src/util/discover.ml
index a330296..cf1517c 100644
--- a/src/util/discover.ml
+++ b/src/util/discover.ml
@@ -94,6 +94,15 @@ external test : unit -> unit = \"lwt_test\"
let () = test ()
"
+let trivial_code = "
+#include <caml/mlvalues.h>
+
+CAMLprim value lwt_test(value Unit)
+{
+ return Val_unit;
+}
+"
+
let pthread_code = "
#include <caml/mlvalues.h>
#include <pthread.h>
@@ -538,6 +547,18 @@ let () =
safe_remove (Filename.chop_extension !caml_file ^ ".cmi");
safe_remove (Filename.chop_extension !caml_file ^ ".cmo"));
+ let exit status =
+ if status <> 0 then begin
+ if !debug then printf "
+See %s for more details.
+ " !log_file
+ else printf "
+Run with DEBUG=y for more details.
+ ";
+ end;
+ exit status
+ in
+
let setup_data = ref [] in
(* Test for pkg-config. *)
@@ -549,6 +570,10 @@ let () =
let have_pkg_config = !not_available = [] in
not_available := [];
+ let test_basic_compilation () =
+ test_code ([], []) trivial_code
+ in
+
let test_libev () =
let opt, lib =
lib_flags "LIBEV"
@@ -612,6 +637,14 @@ let () =
fprintf config "#define NANOSEC%s\n" conversion
in
+ if not (test_basic_compilation ()) then begin
+ printf "
+Error: failed to compile a trivial ocaml toplevel.
+You may be missing core components (compiler, ncurses, etc)
+";
+ exit 1
+ end;
+
test_feature ~do_check:!use_libev "libev" "HAVE_LIBEV" test_libev;
test_feature ~do_check:!use_pthread "pthread" "HAVE_PTHREAD" test_pthread;
test_feature ~do_check:!use_glib "glib" "" test_glib;
diff --git a/src/util/lwt.install b/src/util/lwt.install
new file mode 100644
index 0000000..bdf8496
--- /dev/null
+++ b/src/util/lwt.install
@@ -0,0 +1,6 @@
+lib: "lwt.opam" { "opam" }
+doc: [
+ "README.md"
+ "CHANGES"
+ "doc/COPYING" { "LICENSE" }
+]
diff --git a/tests/META b/tests/META
index fdc382b..b535684 100644
--- a/tests/META
+++ b/tests/META
@@ -1,6 +1,6 @@
# OASIS_START
-# DO NOT EDIT (digest: c63f845ccc3227a8f00788cdd3b6b300)
-version = "2.7.0"
+# DO NOT EDIT (digest: 315419b154d34604f70519d29eca23d9)
+version = "2.7.1"
description = "Monadic promises and concurrent I/O"
requires = "lwt unix lwt.unix"
archive(byte) = "test.cma"
diff --git a/tests/unix/main.ml b/tests/unix/main.ml
index 5550dc7..c648d14 100644
--- a/tests/unix/main.ml
+++ b/tests/unix/main.ml
@@ -20,11 +20,33 @@
* 02111-1307, USA.
*)
-Test.run "unix" [
- Test_lwt_unix.suite;
- Test_lwt_io.suite;
- Test_lwt_io_non_block.suite;
- Test_lwt_process.suite;
- Test_lwt_engine.suite;
- Test_mcast.suite;
-]
+let is_fd_open fd_ =
+ let fd = (Obj.magic (int_of_string fd_) : Unix.file_descr) in
+ let buf = Bytes.create 42 in
+ try
+ ignore (Unix.read fd buf 0 42);
+ true
+ with Unix.Unix_error(Unix.EBADF, _, _) ->
+ false
+
+let () =
+ try
+ assert (not @@ is_fd_open @@ Unix.getenv Test_lwt_unix.assert_fd_closed);
+ exit 0
+ with Not_found -> ()
+
+let () =
+ try
+ assert (is_fd_open @@ Unix.getenv Test_lwt_unix.assert_fd_open);
+ exit 0
+ with Not_found -> ()
+
+let () =
+ Test.run "unix" [
+ Test_lwt_unix.suite;
+ Test_lwt_io.suite;
+ Test_lwt_io_non_block.suite;
+ Test_lwt_process.suite;
+ Test_lwt_engine.suite;
+ Test_mcast.suite;
+ ]
diff --git a/tests/unix/test_lwt_io_non_block.ml b/tests/unix/test_lwt_io_non_block.ml
index 1f58bbd..a48154e 100644
--- a/tests/unix/test_lwt_io_non_block.ml
+++ b/tests/unix/test_lwt_io_non_block.ml
@@ -37,6 +37,15 @@ let suite = suite "lwt_io non blocking io" [
test "file does not exist"
(fun () -> Lwt_unix.file_exists test_file >|= fun r -> not r);
+ test "file does not exist (invalid path)"
+ (fun () -> Lwt_unix.file_exists (test_file ^ "/foo") >|= fun r -> not r);
+
+ test "file does not exist (LargeFile)"
+ (fun () -> Lwt_unix.LargeFile.file_exists test_file >|= fun r -> not r);
+
+ test "file does not exist (LargeFile, invalid path)"
+ (fun () -> Lwt_unix.LargeFile.file_exists (test_file ^ "/foo") >|= fun r -> not r);
+
test "create file"
(fun () ->
Lwt_io.open_file ~mode:Lwt_io.output test_file >>= fun out_chan ->
@@ -47,6 +56,15 @@ let suite = suite "lwt_io non blocking io" [
test "file exists"
(fun () -> Lwt_unix.file_exists test_file);
+ test "file does not exist (invalid path)"
+ (fun () -> Lwt_unix.file_exists (test_file ^ "/foo") >|= fun r -> not r);
+
+ test "file exists (LargeFile)"
+ (fun () -> Lwt_unix.LargeFile.file_exists test_file);
+
+ test "file does not exist (LargeFile, invalid path)"
+ (fun () -> Lwt_unix.LargeFile.file_exists (test_file ^ "/foo") >|= fun r -> not r);
+
test "read file"
(fun () ->
Lwt_io.open_file ~mode:Lwt_io.input test_file >>= fun in_chan ->
diff --git a/tests/unix/test_lwt_unix.ml b/tests/unix/test_lwt_unix.cppo.ml
similarity index 92%
rename from tests/unix/test_lwt_unix.ml
rename to tests/unix/test_lwt_unix.cppo.ml
index 066b597..48d1f0d 100644
--- a/tests/unix/test_lwt_unix.ml
+++ b/tests/unix/test_lwt_unix.cppo.ml
@@ -22,6 +22,47 @@
open Test
open Lwt.Infix
+let assert_fd_closed = "ASSERT_FD_CLOSED"
+let assert_fd_open = "ASSERT_FD_OPEN"
+
+let test_cloexec assertion flags =
+ if Sys.win32 then Lwt.return true
+ else
+ Lwt_unix.openfile "/dev/zero" (Unix.O_RDONLY :: flags) 0o644 >>= fun fd ->
+ let fd_ = Lwt_unix.unix_file_descr fd in
+ match Lwt_unix.fork () with
+ | 0 ->
+ Unix.putenv assertion (string_of_int @@ Obj.magic fd_);
+ (* There's no portable way to obtain the executable name (which
+ * may even no longer exist at this point), but argv[0] fortunately
+ * has the right value when the tests are run with "make test". *)
+ Unix.execv Sys.argv.(0) [||]
+ | n ->
+ Lwt_unix.close fd >>= fun () ->
+ Lwt_unix.waitpid [] n >>= function
+ | _, Unix.WEXITED 0 -> Lwt.return_true
+ | _, (Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _) ->
+ Lwt.return_false
+
+let openfile_tests = [
+ test "openfile: O_CLOEXEC"
+ (fun () -> test_cloexec assert_fd_closed [Unix.O_CLOEXEC]);
+
+ test "openfile: O_CLOEXEC not given"
+ (fun () -> test_cloexec assert_fd_open []);
+
+#if OCAML_VERSION >= (4, 05, 0)
+ test "openfile: O_KEEPEXEC"
+ (fun () -> test_cloexec assert_fd_open [Unix.O_KEEPEXEC]);
+
+ test "openfile: O_CLOEXEC, O_KEEPEXEC"
+ (fun () -> test_cloexec assert_fd_closed [Unix.O_CLOEXEC; Unix.O_KEEPEXEC]);
+
+ test "openfile: O_KEEPEXEC, O_CLOEXEC"
+ (fun () -> test_cloexec assert_fd_closed [Unix.O_KEEPEXEC; Unix.O_CLOEXEC]);
+#endif
+]
+
let utimes_tests = [
test "utimes: basic"
(fun () ->
@@ -638,7 +679,8 @@ let bind_tests = [
let suite =
suite "lwt_unix"
- (utimes_tests @
+ (openfile_tests @
+ utimes_tests @
readdir_tests @
readv_tests @
writev_tests @
--
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