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 <st...@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:antonbac...@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 <antonbac...@yahoo.com>" +version: "2.7.1" +maintainer: [ + "Anton Bachin <antonbac...@yahoo.com>" + "Mauricio Fernandez <m...@acm.org>" + "Simon Cruanes <simon.cruanes.2...@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 _______________________________________________ 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