diff --git a/.travis.yml b/.travis.yml index b83b7d2631..12e24bf5d0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -6,6 +6,8 @@ matrix: env: COMPILER=4.03 - os: linux env: COMPILER=4.04 + - os: linux + env: COMPILER=4.05 - os: linux env: COMPILER=4.04 FLAMBDA=yes - os: linux diff --git a/_oasis b/_oasis index 9ce8cc8831..0797216465 100644 --- a/_oasis +++ b/_oasis @@ -31,7 +31,8 @@ XDevFilesEnableMakefile: false PostConfCommand: ocaml src/util/discover.ml -ext-obj $ext_obj -exec-name $default_executable_name -use-libev $libev -os-type $os_type -use-glib $glib -ccomp-type $ccomp_type -use-pthread $pthread -use-unix $unix -android-target $android_target -libev_default $libev_default PostDistCleanCommand: $rm src/unix/lwt_config.h src/unix/lwt_config.ml src/unix/lwt_unix_jobs_generated.ml src/unix/jobs-unix/* -AlphaFeatures: pure_interface +AlphaFeatures: pure_interface, ocamlbuild_more_args +XOCamlbuildPluginTags: package(cppo_ocamlbuild) Synopsis: Monadic promises and concurrent I/O Description: diff --git a/_tags b/_tags index 931c779916..6f37a509a9 100644 --- a/_tags +++ b/_tags @@ -1,6 +1,10 @@ # -*- conf -*- not : 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. or : warn(-4) diff --git a/lwt.opam b/lwt.opam index 09e53af19c..8ad7bba451 100644 --- a/lwt.opam +++ b/lwt.opam @@ -35,10 +35,11 @@ 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} ) ## OASIS is not required in released version - "oasis" {build & >= "0.4.7"} + "oasis" {build & >= "0.4.8"} ] depopts: [ "base-threads" diff --git a/myocamlbuild.ml b/myocamlbuild.ml index d867139dae..d29f43a6b0 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -91,6 +91,8 @@ let () = dispatch begin fun hook -> () in + Ocamlbuild_cppo.dispatcher hook; + dispatch_default hook; match hook with diff --git a/src/unix/lwt_bytes.ml b/src/unix/lwt_bytes.ml index 551e0ab4c7..082febb765 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_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 9a25906d2d..b668a88874 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" @@ -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 99% rename from src/unix/lwt_unix.mli rename to src/unix/lwt_unix.cppo.mli index cbfa23595f..337c1a7b1b 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]. *) diff --git a/src/unix/lwt_unix_unix.c b/src/unix/lwt_unix_unix.c index d2ba916f96..6590a82e6f 100644 --- a/src/unix/lwt_unix_unix.c +++ b/src/unix/lwt_unix_unix.c @@ -26,6 +26,8 @@ #define ARGS(args...) args +#include +#include #include #include #include @@ -1124,28 +1126,24 @@ static int open_flag_table[] = { O_SYNC, O_RSYNC, 0, -#ifdef O_CLOEXEC - O_CLOEXEC -#else -#define NEED_CLOEXEC_EMULATION - 0 -#endif + 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/travis.sh b/src/util/travis.sh index 3a2202e9a9..3bb4df290f 100644 --- a/src/util/travis.sh +++ b/src/util/travis.sh @@ -9,6 +9,7 @@ packages_apt () { 4.02) PPA=avsm/ocaml42+opam12;; 4.03) PPA=avsm/ocaml42+opam12; DO_SWITCH=yes;; 4.04) PPA=avsm/ocaml42+opam12; DO_SWITCH=yes;; + 4.05) PPA=avsm/ocaml42+opam12; DO_SWITCH=yes;; *) echo Unsupported compiler $COMPILER; exit 1;; esac @@ -85,6 +86,7 @@ case $COMPILER in 4.02) OCAML_VERSION=4.02.3;; 4.03) OCAML_VERSION=4.03.0;; 4.04) OCAML_VERSION=4.04.0;; + 4.05) OCAML_VERSION=4.05.0+beta2;; system) OCAML_VERSION=`ocamlc -version`;; *) echo Unsupported compiler $COMPILER; exit 1;; esac diff --git a/tests/unix/main.ml b/tests/unix/main.ml index 5550dc739b..c648d14011 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_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 066b597f54..48d1f0d97e 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 @