diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index ff1e49e19..00d33feae 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -28,51 +28,16 @@ jobs: libev: - true - false - ppx: - - true - local-packages: - - | - *.opam include: - os: ubuntu-latest ocaml-compiler: ocaml-variants.5.2.0+options,ocaml-option-flambda,ocaml-option-musl,ocaml-option-static,ocaml-option-no-compression libev: false - ppx: true - local-packages: | - *.opam - os: macos-latest - ocaml-compiler: "5.2" - libev: true - ppx: true - local-packages: | - *.opam - - os: windows-latest ocaml-compiler: "5.2" libev: false - ppx: true - local-packages: | - *.opam - - os: ubuntu-latest - ocaml-compiler: "5.2" - libev: true - ppx: false - local-packages: | - *.opam - !lwt_ppx.opam - - os: macos-latest - ocaml-compiler: "5.2" - libev: true - ppx: false - local-packages: | - *.opam - !lwt_ppx.opam - os: windows-latest ocaml-compiler: "5.2" libev: false - ppx: false - local-packages: | - *.opam - !lwt_ppx.opam runs-on: ${{ matrix.os }} @@ -84,37 +49,26 @@ jobs: uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - opam-local-packages: ${{ matrix.local-packages }} - run: opam install conf-libev if: ${{ matrix.libev == true }} - - run: opam install lwt_react lwt --deps-only --with-test - - - run: opam install lwt_ppx --deps-only --with-test - if: ${{ matrix.ppx == true }} - - - run: opam exec -- dune build --only-packages lwt_react,lwt + - run: opam install . --deps-only --with-test - - run: opam exec -- dune build --only-packages lwt_ppx - if: ${{ matrix.ppx == true }} + - run: opam exec -- dune build - - run: opam exec -- dune runtest --only-packages lwt_react,lwt + - run: opam exec -- dune runtest --instrument-with bisect_ppx --force - - run: opam exec -- dune runtest --only-packages lwt_ppx - if: ${{ matrix.ppx == true }} + - run: opam exec -- bisect-ppx-report summary --per-file lint-opam: runs-on: ubuntu-latest - steps: - name: Checkout tree uses: actions/checkout@v4 - - name: Set-up OCaml uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: "5.2" dune-cache: true - - uses: ocaml/setup-ocaml/lint-opam@v3 diff --git a/Makefile b/Makefile index 7a40d9062..022597d5e 100644 --- a/Makefile +++ b/Makefile @@ -68,9 +68,7 @@ EXPECTED_FILES := \ .PHONY: coverage coverage : - rm -rf _build/default/test/ppx_expect - find _build -name '*.coverage' | xargs rm -f - BISECT_ENABLE=yes dune runtest --force + dune runtest --instrument-with bisect_ppx --force bisect-ppx-report html $(EXPECTED_FILES) bisect-ppx-report summary @echo See _coverage/index.html diff --git a/docs/dune b/docs/dune index cb49e843e..380ec0228 100644 --- a/docs/dune +++ b/docs/dune @@ -1,3 +1,3 @@ (documentation (package lwt) - (mld_files :standard)) + (mld_files :standard)) diff --git a/dune-project b/dune-project index b233ce5e1..5c32ef3df 100644 --- a/dune-project +++ b/dune-project @@ -21,7 +21,8 @@ "Shon Feder ") (depends (ocaml (>= 4.08)) - (lwt (>= 5.3.0)))) + (lwt (>= 5.3.0)) + (bisect_ppx :with-test))) (package (name lwt_ppx) @@ -30,6 +31,7 @@ (ocaml (>= 4.08)) (ppxlib (>= 0.16.0)) (ppx_let :with-test) + (bisect_ppx :with-test) lwt)) (package @@ -39,7 +41,8 @@ (ocaml (>= 4.08)) (cppo (and :build (>= 1.1.0))) (lwt (>= 3.0.0)) - (react (>= 1.0.0)))) + (react (>= 1.0.0)) + (bisect_ppx :with-test))) (package (name lwt) @@ -58,6 +61,7 @@ synchronization primitives. Code can be run in parallel on an opt-in basis. (cppo (and :build (>= 1.1.0))) (ocamlfind (and :dev (>= 1.7.3-1))) (odoc (and :with-doc (>= 2.3.0))) + (bisect_ppx :with-test) dune-configurator ocplib-endian) (depopts base-threads base-unix conf-libev)) diff --git a/lwt.opam b/lwt.opam index bc59b1d1e..93a3ed64c 100644 --- a/lwt.opam +++ b/lwt.opam @@ -25,6 +25,7 @@ depends: [ "cppo" {build & >= "1.1.0"} "ocamlfind" {dev & >= "1.7.3-1"} "odoc" {with-doc & >= "2.3.0"} + "bisect_ppx" {with-test} "dune-configurator" "ocplib-endian" ] diff --git a/lwt_ppx.opam b/lwt_ppx.opam index 68b2faf99..57b2c210f 100644 --- a/lwt_ppx.opam +++ b/lwt_ppx.opam @@ -15,6 +15,7 @@ depends: [ "ocaml" {>= "4.08"} "ppxlib" {>= "0.16.0"} "ppx_let" {with-test} + "bisect_ppx" {with-test} "lwt" "odoc" {with-doc} ] diff --git a/lwt_react.opam b/lwt_react.opam index 975424697..c506050bd 100644 --- a/lwt_react.opam +++ b/lwt_react.opam @@ -15,6 +15,7 @@ depends: [ "cppo" {build & >= "1.1.0"} "lwt" {>= "3.0.0"} "react" {>= "1.0.0"} + "bisect_ppx" {with-test} "odoc" {with-doc} ] build: [ diff --git a/lwt_retry.opam b/lwt_retry.opam index fa7cedce3..0598300ce 100644 --- a/lwt_retry.opam +++ b/lwt_retry.opam @@ -13,6 +13,7 @@ depends: [ "dune" {>= "2.7"} "ocaml" {>= "4.08"} "lwt" {>= "5.3.0"} + "bisect_ppx" {with-test} "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocsigen/lwt.git" diff --git a/src/core/dune b/src/core/dune index 9b890d185..dab7ccc8d 100644 --- a/src/core/dune +++ b/src/core/dune @@ -1,21 +1,9 @@ -(* -*- tuareg -*- *) - -let preprocess = - match Sys.getenv "BISECT_ENABLE" with - | "yes" -> "(preprocess (pps bisect_ppx))" - | _ -> "" - | exception _ -> "" - -let () = Jbuild_plugin.V1.send @@ {| - (library (public_name lwt) (synopsis "Monadic promises and concurrent I/O") (wrapped false) - |} ^ preprocess ^ {| - (flags (:standard -w +A-29))) + (instrumentation + (backend bisect_ppx))) (documentation (package lwt)) - -|} diff --git a/src/core/lwt.ml b/src/core/lwt.ml index be6f5128f..89aed2170 100644 --- a/src/core/lwt.ml +++ b/src/core/lwt.ml @@ -349,9 +349,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] (* Some sequence-associated storage types @@ -830,14 +828,14 @@ struct | Regular_callback_list_empty, _ -> l2 | _, Regular_callback_list_empty -> l1 | _, _ -> Regular_callback_list_concat (l1, l2) - end [@ocaml.warning "-4"] + end let concat_cancel_callbacks l1 l2 = begin match l1, l2 with | Cancel_callback_list_empty, _ -> l2 | _, Cancel_callback_list_empty -> l1 | _, _ -> Cancel_callback_list_concat (l1, l2) - end [@ocaml.warning "-4"] + end (* In a callback list, filters out cells of explicitly removable callbacks that have been removed. *) diff --git a/src/core/lwt_condition.ml b/src/core/lwt_condition.ml index 1e18f0b03..0366dabd5 100644 --- a/src/core/lwt_condition.ml +++ b/src/core/lwt_condition.ml @@ -31,9 +31,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] type 'a t = 'a Lwt.u Lwt_sequence.t diff --git a/src/core/lwt_mutex.ml b/src/core/lwt_mutex.ml index 93bd12ab0..c49694163 100644 --- a/src/core/lwt_mutex.ml +++ b/src/core/lwt_mutex.ml @@ -8,9 +8,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] open Lwt.Infix diff --git a/src/core/lwt_mvar.ml b/src/core/lwt_mvar.ml index ea96bd65a..f759339ef 100644 --- a/src/core/lwt_mvar.ml +++ b/src/core/lwt_mvar.ml @@ -34,9 +34,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] type 'a t = { mutable mvar_contents : 'a option; diff --git a/src/core/lwt_pool.ml b/src/core/lwt_pool.ml index bf06787ab..f63e30100 100644 --- a/src/core/lwt_pool.ml +++ b/src/core/lwt_pool.ml @@ -8,9 +8,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] open Lwt.Infix diff --git a/src/ppx/dune b/src/ppx/dune index 34f7513dd..1a48fc938 100644 --- a/src/ppx/dune +++ b/src/ppx/dune @@ -1,22 +1,10 @@ -(* -*- tuareg -*- *) - -let bisect_ppx = - match Sys.getenv "BISECT_ENABLE" with - | "yes" -> "bisect_ppx" - | _ -> "" - | exception _ -> "" - -let () = Jbuild_plugin.V1.send @@ {| - (library - (name ppx_lwt) (public_name lwt_ppx) (synopsis "Lwt PPX syntax extension") - (modules ppx_lwt) (libraries ppxlib) (ppx_runtime_libraries lwt) (kind ppx_rewriter) - (preprocess (pps ppxlib.metaquot|} ^ bisect_ppx ^ {|)) - (flags (:standard -w +A-4))) - -|} + (preprocess + (pps ppxlib.metaquot)) + (instrumentation + (backend bisect_ppx))) diff --git a/src/react/dune b/src/react/dune index 116f8454e..be26a6c34 100644 --- a/src/react/dune +++ b/src/react/dune @@ -1,19 +1,7 @@ -(* -*- tuareg -*- *) - -let preprocess = - match Sys.getenv "BISECT_ENABLE" with - | "yes" -> "(preprocess (pps bisect_ppx))" - | _ -> "" - | exception _ -> "" - -let () = Jbuild_plugin.V1.send @@ {| - (library (public_name lwt_react) (synopsis "Reactive programming helpers for Lwt") (wrapped false) (libraries lwt react) - |} ^ preprocess ^ {| - (flags (:standard -w +A))) - -|} + (instrumentation + (backend bisect_ppx))) diff --git a/src/retry/dune b/src/retry/dune index 2a09d3d6e..0dd136a47 100644 --- a/src/retry/dune +++ b/src/retry/dune @@ -1,19 +1,7 @@ -(* -*- tuareg -*- *) - -let preprocess = - match Sys.getenv "BISECT_ENABLE" with - | "yes" -> "(preprocess (pps bisect_ppx))" - | _ -> "" - | exception _ -> "" - -let () = Jbuild_plugin.V1.send @@ {| - (library (public_name lwt_retry) (synopsis "A utility for retrying Lwt computations") (wrapped false) (libraries lwt lwt.unix) - |} ^ preprocess ^ {| - (flags (:standard -w +A))) - -|} + (instrumentation + (backend bisect_ppx))) diff --git a/src/unix/dune b/src/unix/dune index 830eb256a..a5c6a3977 100644 --- a/src/unix/dune +++ b/src/unix/dune @@ -1,189 +1,196 @@ -(* -*- tuareg -*- *) - -let preprocess = - match Sys.getenv "BISECT_ENABLE" with - | "yes" -> "(preprocess (pps bisect_ppx))" - | _ -> "" - | exception _ -> "" - -let () = Jbuild_plugin.V1.send @@ {| - (rule (targets lwt_process.ml) - (deps (:ml lwt_process.cppo.ml)) + (deps + (:ml lwt_process.cppo.ml)) (action - (chdir %{project_root} + (chdir + %{project_root} (run %{bin:cppo} -V OCAML:%{ocaml_version} %{ml} -o %{targets})))) (rule (targets lwt_unix.ml) - (deps (:ml lwt_unix.cppo.ml)) + (deps + (:ml lwt_unix.cppo.ml)) (action - (chdir %{project_root} + (chdir + %{project_root} (run %{bin:cppo} -V OCAML:%{ocaml_version} %{ml} -o %{targets})))) (rule (targets lwt_unix.mli) - (deps (:ml lwt_unix.cppo.mli)) + (deps + (:ml lwt_unix.cppo.mli)) (action - (chdir %{project_root} + (chdir + %{project_root} (run %{bin:cppo} -V OCAML:%{ocaml_version} %{ml} -o %{targets})))) (rule (mode fallback) (targets discover_arguments) - (action (with-stdout-to %{targets} (echo "")))) + (action + (with-stdout-to + %{targets} + (echo "")))) (rule (targets - unix_c_flags.sexp unix_c_library_flags.sexp lwt_features.h lwt_features.ml) - (deps (:exe config/discover.exe) discover_arguments) - (action (run %{exe}))) + unix_c_flags.sexp + unix_c_library_flags.sexp + lwt_features.h + lwt_features.ml) + (deps + (:exe config/discover.exe) + discover_arguments) + (action + (run %{exe}))) (copy_files unix_c/*) + (copy_files windows_c/*.c) (library (name lwt_unix) (public_name lwt.unix) (synopsis "Unix support for Lwt") - (optional) (wrapped false) (libraries bigarray lwt ocplib-endian.bigstring threads unix) - |} ^ preprocess ^ {| (install_c_headers lwt_features lwt_config lwt_unix) (foreign_stubs - (language c) - (names - lwt_unix_stubs - lwt_libev_stubs - lwt_process_stubs - unix_readable - unix_writable - unix_madvise - unix_get_page_size - windows_get_page_size - unix_mincore - unix_read - unix_pread - windows_read - windows_pread - unix_bytes_read - windows_bytes_read - unix_write - unix_pwrite - windows_write - windows_pwrite - unix_bytes_write - windows_bytes_write - unix_readv_writev_utils - unix_iov_max - unix_writev - unix_writev_job - unix_readv - unix_readv_job - unix_send - unix_bytes_send - unix_recv - unix_bytes_recv - unix_recvfrom - unix_bytes_recvfrom - unix_sendto - unix_sendto_byte - unix_bytes_sendto - unix_bytes_sendto_byte - unix_recv_send_utils - unix_recv_msg - unix_send_msg - unix_send_msg_byte - unix_get_credentials - unix_mcast_utils - unix_mcast_set_loop - unix_mcast_set_ttl - unix_mcast_modify_membership - unix_wait4 - unix_get_cpu - unix_get_affinity - unix_set_affinity - unix_guess_blocking_job - unix_wait_mincore_job - unix_open_job - unix_read_job - unix_pread_job - windows_read_job - windows_pread_job - unix_bytes_read_job - windows_bytes_read_job - unix_write_job - windows_write_job - unix_pwrite_job - windows_pwrite_job - unix_bytes_write_job - windows_bytes_write_job - unix_stat_job_utils - unix_stat_job - unix_stat_64_job - unix_lstat_job - unix_lstat_64_job - unix_fstat_job - unix_fstat_64_job - unix_utimes_job - unix_isatty_job - unix_opendir_job - unix_closedir_job - unix_valid_dir - unix_invalidate_dir - unix_rewinddir_job - unix_readdir_job - unix_readdir_n_job - unix_readlink_job - unix_lockf_job - unix_getlogin_job - unix_get_pw_gr_nam_id_job - unix_get_network_information_utils - unix_gethostname_job - unix_gethostbyname_job - unix_gethostbyaddr_job - unix_getprotoby_getservby_job - unix_getaddrinfo_job - unix_getnameinfo_job - unix_bind_job - unix_getcwd_job - unix_termios_conversion - unix_tcgetattr_job - unix_tcsetattr_job - windows_is_socket - windows_fsync_job - windows_system_job - windows_not_available - unix_not_available - unix_access_job - unix_chdir_job - unix_chmod_job - unix_chown_job - unix_chroot_job - unix_close_job - unix_fchmod_job - unix_fchown_job - unix_fdatasync_job - unix_fsync_job - unix_ftruncate_job - unix_link_job - unix_lseek_job - unix_mkdir_job - unix_mkfifo_job - unix_rename_job - unix_rmdir_job - unix_symlink_job - unix_tcdrain_job - unix_tcflow_job - unix_tcflush_job - unix_tcsendbreak_job - unix_truncate_job - unix_unlink_job - unix_somaxconn - windows_somaxconn - unix_accept4) - (flags (:include unix_c_flags.sexp))) - (c_library_flags (:include unix_c_library_flags.sexp))) -|} + (language c) + (names + lwt_unix_stubs + lwt_libev_stubs + lwt_process_stubs + unix_readable + unix_writable + unix_madvise + unix_get_page_size + windows_get_page_size + unix_mincore + unix_read + unix_pread + windows_read + windows_pread + unix_bytes_read + windows_bytes_read + unix_write + unix_pwrite + windows_write + windows_pwrite + unix_bytes_write + windows_bytes_write + unix_readv_writev_utils + unix_iov_max + unix_writev + unix_writev_job + unix_readv + unix_readv_job + unix_send + unix_bytes_send + unix_recv + unix_bytes_recv + unix_recvfrom + unix_bytes_recvfrom + unix_sendto + unix_sendto_byte + unix_bytes_sendto + unix_bytes_sendto_byte + unix_recv_send_utils + unix_recv_msg + unix_send_msg + unix_send_msg_byte + unix_get_credentials + unix_mcast_utils + unix_mcast_set_loop + unix_mcast_set_ttl + unix_mcast_modify_membership + unix_wait4 + unix_get_cpu + unix_get_affinity + unix_set_affinity + unix_guess_blocking_job + unix_wait_mincore_job + unix_open_job + unix_read_job + unix_pread_job + windows_read_job + windows_pread_job + unix_bytes_read_job + windows_bytes_read_job + unix_write_job + windows_write_job + unix_pwrite_job + windows_pwrite_job + unix_bytes_write_job + windows_bytes_write_job + unix_stat_job_utils + unix_stat_job + unix_stat_64_job + unix_lstat_job + unix_lstat_64_job + unix_fstat_job + unix_fstat_64_job + unix_utimes_job + unix_isatty_job + unix_opendir_job + unix_closedir_job + unix_valid_dir + unix_invalidate_dir + unix_rewinddir_job + unix_readdir_job + unix_readdir_n_job + unix_readlink_job + unix_lockf_job + unix_getlogin_job + unix_get_pw_gr_nam_id_job + unix_get_network_information_utils + unix_gethostname_job + unix_gethostbyname_job + unix_gethostbyaddr_job + unix_getprotoby_getservby_job + unix_getaddrinfo_job + unix_getnameinfo_job + unix_bind_job + unix_getcwd_job + unix_termios_conversion + unix_tcgetattr_job + unix_tcsetattr_job + windows_is_socket + windows_fsync_job + windows_system_job + windows_not_available + unix_not_available + unix_access_job + unix_chdir_job + unix_chmod_job + unix_chown_job + unix_chroot_job + unix_close_job + unix_fchmod_job + unix_fchown_job + unix_fdatasync_job + unix_fsync_job + unix_ftruncate_job + unix_link_job + unix_lseek_job + unix_mkdir_job + unix_mkfifo_job + unix_rename_job + unix_rmdir_job + unix_symlink_job + unix_tcdrain_job + unix_tcflow_job + unix_tcflush_job + unix_tcsendbreak_job + unix_truncate_job + unix_unlink_job + unix_somaxconn + windows_somaxconn + unix_accept4) + (flags + (:include unix_c_flags.sexp))) + (c_library_flags + (:include unix_c_library_flags.sexp)) + (instrumentation + (backend bisect_ppx))) diff --git a/src/unix/lwt_bytes.ml b/src/unix/lwt_bytes.ml index 1b34120c6..b83866710 100644 --- a/src/unix/lwt_bytes.ml +++ b/src/unix/lwt_bytes.ml @@ -16,9 +16,8 @@ external set : t -> int -> char -> unit = "%caml_ba_set_1" external unsafe_get : t -> int -> char = "%caml_ba_unsafe_ref_1" external unsafe_set : t -> int -> char -> unit = "%caml_ba_unsafe_set_1" -[@@@ocaml.warning "-3"] external unsafe_fill : t -> int -> int -> char -> unit = "lwt_unix_fill_bytes" "noalloc" -[@@@ocaml.warning "+3"] +[@@ocaml.warning "-3"] let fill bytes ofs len ch = if ofs < 0 || len < 0 || ofs > length bytes - len then @@ -179,9 +178,8 @@ let map_file ~fd ?pos ~shared ?(size=(-1)) () = Unix.map_file fd ?pos char c_layout shared [|size|] |> Bigarray.array1_of_genarray -[@@@ocaml.warning "-3"] external mapped : t -> bool = "lwt_unix_mapped" "noalloc" -[@@@ocaml.warning "+3"] +[@@ocaml.warning "-3"] type advice = | MADV_NORMAL diff --git a/src/unix/lwt_engine.ml b/src/unix/lwt_engine.ml index 17618e133..20a8eafc7 100644 --- a/src/unix/lwt_engine.ml +++ b/src/unix/lwt_engine.ml @@ -8,9 +8,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] (* +-----------------------------------------------------------------+ | Events | @@ -227,7 +225,7 @@ module Sleep_queue = type t = sleeper let compare {time = t1; _} {time = t2; _} = compare t1 t2 end) - [@@ocaml.warning "-3"] + [@ocaml.warning "-3"] module Fd_map = Map.Make(struct type t = Unix.file_descr let compare = compare end) diff --git a/src/unix/lwt_gc.ml b/src/unix/lwt_gc.ml index 12b9e107b..b0925f9dc 100644 --- a/src/unix/lwt_gc.ml +++ b/src/unix/lwt_gc.ml @@ -8,9 +8,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] let ensure_termination t = if Lwt.state t = Lwt.Sleep then begin diff --git a/src/unix/lwt_io.ml b/src/unix/lwt_io.ml index 8b3033fae..9a24aa02a 100644 --- a/src/unix/lwt_io.ml +++ b/src/unix/lwt_io.ml @@ -8,9 +8,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] open Lwt.Infix @@ -231,7 +229,7 @@ let perform_io : type mode. mode _channel -> int Lwt.t = fun ch -> (function | Unix.Unix_error (Unix.EPIPE, _, _) -> Lwt.return 0 - | exn -> Lwt.reraise exn) [@ocaml.warning "-4"] + | exn -> Lwt.reraise exn) else perform ch.buffer ptr len in @@ -1549,7 +1547,7 @@ let close_socket fd = (function (* Occurs if the peer closes the connection first. *) | Unix.Unix_error (Unix.ENOTCONN, _, _) -> Lwt.return_unit - | exn -> Lwt.reraise exn) [@ocaml.warning "-4"]) + | exn -> Lwt.reraise exn)) (fun () -> Lwt_unix.close fd) @@ -1661,7 +1659,7 @@ let establish_server_generic Unix.unlink path | _ -> () - end [@ocaml.warning "-4"]; + end; Lwt.wakeup_later notify_listening_socket_closed (); Lwt.return_unit diff --git a/src/unix/lwt_main.ml b/src/unix/lwt_main.ml index 356dc318f..823666e5f 100644 --- a/src/unix/lwt_main.ml +++ b/src/unix/lwt_main.ml @@ -8,9 +8,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] open Lwt.Infix diff --git a/src/unix/lwt_preemptive.ml b/src/unix/lwt_preemptive.ml index 357bd29fd..eacf32f28 100644 --- a/src/unix/lwt_preemptive.ml +++ b/src/unix/lwt_preemptive.ml @@ -8,9 +8,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] open Lwt.Infix diff --git a/src/unix/lwt_process.cppo.ml b/src/unix/lwt_process.cppo.ml index ceb86be23..3990c8269 100644 --- a/src/unix/lwt_process.cppo.ml +++ b/src/unix/lwt_process.cppo.ml @@ -378,7 +378,7 @@ let read_opt read ic = (function | Unix.Unix_error (Unix.EPIPE, _, _) | End_of_file -> Lwt.return_none - | exn -> Lwt.reraise exn) [@ocaml.warning "-4"] + | exn -> Lwt.reraise exn) let recv_chars pr = let ic = pr#stdout in diff --git a/src/unix/lwt_unix.cppo.ml b/src/unix/lwt_unix.cppo.ml index 5edb4b83d..09ebf2976 100644 --- a/src/unix/lwt_unix.cppo.ml +++ b/src/unix/lwt_unix.cppo.ml @@ -8,9 +8,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] open Lwt.Infix @@ -161,12 +159,11 @@ external start_job : 'a job -> async_method -> bool = "lwt_unix_start_job" (* Starts the given job with given parameters. It returns [true] if the job is already terminated. *) -[@@@ocaml.warning "-3"] external check_job : 'a job -> int -> bool = "lwt_unix_check_job" "noalloc" (* Check whether that a job has terminated or not. If it has not yet terminated, it is marked so it will send a notification when it finishes. *) -[@@@ocaml.warning "+3"] +[@@ocaml.warning "-3"] (* For all running job, a waiter and a function to abort it. *) let jobs = Lwt_sequence.create () @@ -228,11 +225,10 @@ let choose_async_method = function | Some am -> am | None -> !default_async_method_var -[@@@ocaml.warning "-16"] let execute_job ?async_method ~job ~result ~free = let async_method = choose_async_method async_method in run_job_aux async_method job (fun job -> let x = wrap_result result job in free job; x) -[@@@ocaml.warning "+16"] + [@@ocaml.warning "-16"] external self_result : 'a job -> 'a = "lwt_unix_self_result" (* returns the result of a job using the [result] field of the C @@ -304,9 +300,8 @@ type file_descr = { (* Hooks to call when the file descriptor becomes writable. *) } -[@@@ocaml.warning "-3"] external is_socket : Unix.file_descr -> bool = "lwt_unix_is_socket" "noalloc" -[@@@ocaml.warning "+3"] +[@@ocaml.warning "-3"] external guess_blocking_job : Unix.file_descr -> bool job = "lwt_unix_guess_blocking_job" @@ -1034,7 +1029,7 @@ let file_exists name = (fun e -> match e with | Unix.Unix_error _ -> Lwt.return_false - | _ -> Lwt.reraise e) [@ocaml.warning "-4"] + | _ -> Lwt.reraise e) external utimes_job : string -> float -> float -> unit job = "lwt_unix_utimes_job" @@ -1140,7 +1135,7 @@ struct (fun e -> match e with | Unix.Unix_error _ -> Lwt.return_false - | _ -> Lwt.reraise e) [@ocaml.warning "-4"] + | _ -> Lwt.reraise e) end diff --git a/test/core/dune b/test/core/dune index b03d5ef18..1a3c883ab 100644 --- a/test/core/dune +++ b/test/core/dune @@ -1,6 +1,4 @@ (test (name main) (package lwt) - (libraries lwttester) - (preprocess (future_syntax)) - (flags (:standard -w +A-40-42))) + (libraries lwttester)) diff --git a/test/core/test_lwt.ml b/test/core/test_lwt.ml index 2ba5ab564..f22c72233 100644 --- a/test/core/test_lwt.ml +++ b/test/core/test_lwt.ml @@ -8,9 +8,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] open Test @@ -2330,7 +2328,7 @@ let choose_tests = suite "choose" [ | Lwt.Fail Exception -> repeat (n - 1) | Lwt.Return "bar" -> false | _ -> assert false - end [@ocaml.warning "-4"]; + end in let count = 100 in Lwt.return (repeat count) @@ -2439,7 +2437,7 @@ let nchoose_split_tests = suite "nchoose_split" [ begin match Lwt.state p with | Lwt.Return (["foo"; "bar"], [_]) -> Lwt.return_true | _ -> Lwt.return_false - end [@ocaml.warning "-4"] + end end; test "fulfilled, rejected" begin fun () -> @@ -2465,7 +2463,7 @@ let nchoose_split_tests = suite "nchoose_split" [ begin match Lwt.state p with | Lwt.Return (["foo"], [_]) -> Lwt.return_true | _ -> Lwt.return_false - end [@ocaml.warning "-4"] + end end; test "pending, rejected 2" begin fun () -> @@ -2482,7 +2480,7 @@ let nchoose_split_tests = suite "nchoose_split" [ begin match Lwt.state p with | Lwt.Return ([(); ()], [_]) -> Lwt.return_true | _ -> Lwt.return_false - end [@ocaml.warning "-4"] + end end; test "diamond, rejected" begin fun () -> @@ -3036,7 +3034,7 @@ let pick_tests = suite "pick" [ && repeat (n - 1) | Lwt.Return "bar" -> false | _ -> assert false - end [@ocaml.warning "-4"]; + end in let count = 100 in Lwt.return (repeat count) diff --git a/test/core/test_lwt_sequence.ml b/test/core/test_lwt_sequence.ml index 83c4030ad..a8b03331c 100644 --- a/test/core/test_lwt_sequence.ml +++ b/test/core/test_lwt_sequence.ml @@ -5,9 +5,7 @@ open Test -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] let filled_sequence () = let s = Lwt_sequence.create () in diff --git a/test/ppx/dune b/test/ppx/dune index 30d4d1957..227d21f27 100644 --- a/test/ppx/dune +++ b/test/ppx/dune @@ -2,5 +2,5 @@ (name main) (package lwt_ppx) (libraries lwttester) - (preprocess (pps lwt_ppx)) - (flags (:standard -warn-error -22))) + (preprocess + (pps lwt_ppx))) diff --git a/test/ppx/main.ml b/test/ppx/main.ml index aa12da251..18db4bdad 100644 --- a/test/ppx/main.ml +++ b/test/ppx/main.ml @@ -6,7 +6,9 @@ open Lwt local module inside the tester function, because that function is run inside an outer call to Lwt_main.run, and nested calls to Lwt_main.run are not allowed. *) +[@@@ocaml.warning "-22"] let%lwt structure_let_result = Lwt.return_true +[@@@ocaml.warning "+22"] let suite = suite "ppx" [ test "let" diff --git a/test/ppx_let/dune b/test/ppx_let/dune index 87529263b..7915e092a 100644 --- a/test/ppx_let/dune +++ b/test/ppx_let/dune @@ -1,5 +1,6 @@ (test (name test) (package lwt_ppx) ;; technically not part of lwt_ppx, but we want it tested and the dependency to ppxlib is already there - (preprocess (pps ppx_let)) + (preprocess + (pps ppx_let)) (libraries lwt lwt.unix)) diff --git a/test/unix/dune b/test/unix/dune index 9dc1df643..009be8242 100644 --- a/test/unix/dune +++ b/test/unix/dune @@ -23,8 +23,7 @@ (package lwt) (libraries lwttester tester) (modules main) - (deps bytes_io_data %{exe:dummy.exe}) -) + (deps bytes_io_data %{exe:dummy.exe})) (test (name ocaml_runtime_exc_1) diff --git a/test/unix/test_lwt_io.ml b/test/unix/test_lwt_io.ml index f902f5e3e..157444768 100644 --- a/test/unix/test_lwt_io.ml +++ b/test/unix/test_lwt_io.ml @@ -8,9 +8,7 @@ ("deprecated"), and create a local, non-deprecated alias for [Lwt_sequence] that can be referred to by the rest of the code in this module without triggering any more warnings. *) -[@@@ocaml.warning "-3"] module Lwt_sequence = Lwt_sequence -[@@@ocaml.warning "+3"] open Test open Lwt.Infix @@ -320,7 +318,7 @@ let suite = suite "lwt_io" [ exceptions_observed := !exceptions_observed + 1; Lwt.return_unit | exn -> - Lwt.reraise exn) [@ocaml.warning "-4"] + Lwt.reraise exn) in let fd_r, fd_w = Lwt_unix.pipe () in diff --git a/test/unix/test_lwt_unix.ml b/test/unix/test_lwt_unix.ml index 609ca3c2a..a4e747aa3 100644 --- a/test/unix/test_lwt_unix.ml +++ b/test/unix/test_lwt_unix.ml @@ -172,7 +172,7 @@ let utimes_tests = [ (function | Unix.Unix_error (Unix.ENOENT, "utimes", _) -> Lwt.return_unit | Unix.Unix_error (Unix.EUNKNOWNERR _, "utimes", _) -> Lwt.return_unit - | e -> Lwt.reraise e) [@ocaml.warning "-4"] >>= fun () -> + | e -> Lwt.reraise e) >>= fun () -> Lwt.return_true); ] @@ -305,7 +305,7 @@ let readdir_tests = (function | Unix.Unix_error (Unix.EBADF, tag', _) when tag' = tag -> Lwt.return_true - | exn -> Lwt.reraise exn) [@ocaml.warning "-4"] + | exn -> Lwt.reraise exn) in Lwt_list.for_all_s (fun (tag, t) -> expect_ebadf tag t) @@ -973,7 +973,7 @@ let bind_tests = of /proc/version, reading it, and checking its contents for the string "WSL". *) raise Skip - | e -> Lwt.reraise e) [@ocaml.warning "-4"] + | e -> Lwt.reraise e) in Lwt.finalize @@ -1014,7 +1014,7 @@ let bind_tests = Lwt.return_false) (function | Unix.Unix_error (Unix.EBADF, _, _) -> Lwt.return_true - | e -> Lwt.reraise e) [@ocaml.warning "-4"]); + | e -> Lwt.reraise e)); test "bind: aborted" (fun () ->