From a69d24b047ddf3ae062cd97bb228229a5b5777eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 8 Dec 2020 10:30:29 +0100 Subject: [PATCH 1/2] Stdlib_unix: externalise Lwt-exit --- .gitlab-ci.yml | 2 +- .gitlab/ci/integration.yml | 180 ------- .gitlab/ci/unittest.yml | 1 - scripts/version.sh | 2 +- src/bin_node/dune | 3 +- src/bin_node/tezos-node.opam | 1 + src/bin_validation/tezos-validator.opam | 1 + src/lib_client_base_unix/dune | 3 +- .../tezos-client-base-unix.opam | 1 + src/lib_protocol_updater/dune | 1 + .../tezos-protocol-updater.opam | 1 + src/lib_shell/dune | 3 +- src/lib_shell/tezos-shell.opam | 1 + src/lib_stdlib_unix/lwt_exit.ml | 501 ------------------ src/lib_stdlib_unix/lwt_exit.mli | 440 --------------- src/lib_stdlib_unix/test/.ocamlformat | 12 - src/lib_stdlib_unix/test/dune | 122 ----- .../test/test_lwt_exit_after.ml | 65 --- .../test/test_lwt_exit_clean_up.ml | 48 -- .../test/test_lwt_exit_clean_up_failure.ml | 56 -- .../test/test_lwt_exit_clean_up_timeout.ml | 57 -- .../test/test_lwt_exit_exit.ml | 40 -- .../test/test_lwt_exit_exit_escape.ml | 42 -- .../test/test_lwt_exit_main_is_clean_up.ml | 186 ------- .../test/test_lwt_exit_raise.ml | 44 -- .../test/test_lwt_exit_raise_exit.ml | 43 -- .../test/test_lwt_exit_range_of_signals.ml | 108 ---- .../test/test_lwt_exit_return.ml | 36 -- .../test/test_lwt_exit_signal.ml | 235 -------- .../test/test_lwt_exit_unregister_clean_up.ml | 51 -- ...lwt_exit_unregister_clean_up_with_after.ml | 61 --- src/proto_007_PsDELPH1/lib_delegate/dune | 3 +- .../tezos-baking-007-PsDELPH1.opam | 1 + src/proto_008_PtEdoTez/lib_delegate/dune | 3 +- .../tezos-baking-008-PtEdoTez.opam | 1 + src/proto_alpha/lib_delegate/dune | 3 +- .../lib_delegate/tezos-baking-alpha.opam | 1 + 37 files changed, 23 insertions(+), 2336 deletions(-) delete mode 100644 src/lib_stdlib_unix/lwt_exit.ml delete mode 100644 src/lib_stdlib_unix/lwt_exit.mli delete mode 100644 src/lib_stdlib_unix/test/.ocamlformat delete mode 100644 src/lib_stdlib_unix/test/dune delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_after.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_clean_up.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_clean_up_failure.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_clean_up_timeout.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_exit.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_exit_escape.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_main_is_clean_up.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_raise.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_raise_exit.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_range_of_signals.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_return.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_signal.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up.ml delete mode 100644 src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up_with_after.ml diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 4b090ef312a8..076148186a1f 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -15,7 +15,7 @@ include: variables: ## Please update `scripts/version.sh` accordingly - build_deps_image_version: 4eb9728016e05758054c600ddc66c7e295c27a26 + build_deps_image_version: 8312444f0f524f5456cdf3660328b6bbffd0107c build_deps_image_name: registry.gitlab.com/tezos/opam-repository public_docker_image_name: docker.io/${CI_PROJECT_PATH} GIT_STRATEGY: fetch diff --git a/.gitlab/ci/integration.yml b/.gitlab/ci/integration.yml index 902bc71e0422..4bf442931a62 100644 --- a/.gitlab/ci/integration.yml +++ b/.gitlab/ci/integration.yml @@ -115,192 +115,12 @@ integration:007_fast: - poetry run pytest tests_007 -k "not slow" -s --log-dir=tmp stage: test -integration:007_baker_endorser: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_baker_endorser.py -s --log-dir=tmp - stage: test - -integration:007_bootstrap: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_bootstrap.py -s --log-dir=tmp - stage: test - -integration:007_contract: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_contract.py -s --log-dir=tmp - stage: test - -integration:007_contract_annotations: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_contract_annotations.py -s --log-dir=tmp - stage: test - -integration:007_contract_macros: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_contract_macros.py -s --log-dir=tmp - stage: test - -integration:007_contract_onchain_opcodes: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_contract_onchain_opcodes.py -s --log-dir=tmp - stage: test - -integration:007_contract_opcodes: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_contract_opcodes.py -s --log-dir=tmp - stage: test - -integration:007_forge_block: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_forge_block.py -s --log-dir=tmp - stage: test - -integration:007_many_bakers: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_many_bakers.py -s --log-dir=tmp - stage: test - -integration:007_many_nodes: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_many_nodes.py -s --log-dir=tmp - stage: test - -integration:007_mempool: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_mempool.py -s --log-dir=tmp - stage: test - -integration:007_multinode_snapshot: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_multinode_snapshot.py -s --log-dir=tmp - stage: test - -integration:007_multinode_storage_reconstruction: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_multinode_storage_reconstruction.py -s --log-dir=tmp - stage: test - -integration:007_proxy: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_proxy.py -s --log-dir=tmp - stage: test - -integration:007_rpc: - extends: .integration_python_template - script: - - poetry run pytest tests_007/test_rpc.py -s --log-dir=tmp - stage: test - integration:008_fast: extends: .integration_python_template script: - poetry run pytest tests_008 -k "not slow" -s --log-dir=tmp stage: test -integration:008_baker_endorser: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_baker_endorser.py -s --log-dir=tmp - stage: test - -integration:008_bootstrap: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_bootstrap.py -s --log-dir=tmp - stage: test - -integration:008_contract: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_contract.py -s --log-dir=tmp - stage: test - -integration:008_contract_annotations: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_contract_annotations.py -s --log-dir=tmp - stage: test - -integration:008_contract_macros: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_contract_macros.py -s --log-dir=tmp - stage: test - -integration:008_contract_onchain_opcodes: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_contract_onchain_opcodes.py -s --log-dir=tmp - stage: test - -integration:008_contract_opcodes: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_contract_opcodes.py -s --log-dir=tmp - stage: test - -integration:008_forge_block: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_forge_block.py -s --log-dir=tmp - stage: test - -integration:008_many_bakers: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_many_bakers.py -s --log-dir=tmp - stage: test - -integration:008_many_nodes: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_many_nodes.py -s --log-dir=tmp - stage: test - -integration:008_mempool: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_mempool.py -s --log-dir=tmp - stage: test - -integration:008_multinode_snapshot: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_multinode_snapshot.py -s --log-dir=tmp - stage: test - -integration:008_multinode_storage_reconstruction: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_multinode_storage_reconstruction.py -s --log-dir=tmp - stage: test - -integration:008_rpc: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_rpc.py -s --log-dir=tmp - stage: test - -integration:008_voting_full: - extends: .integration_python_template - script: - - poetry run pytest tests_008/test_voting_full.py -s --log-dir=tmp - stage: test - integration:alpha_fast: extends: .integration_python_template script: diff --git a/.gitlab/ci/unittest.yml b/.gitlab/ci/unittest.yml index e1a93a5b3aed..5f7e4ac7da2c 100644 --- a/.gitlab/ci/unittest.yml +++ b/.gitlab/ci/unittest.yml @@ -62,7 +62,6 @@ unit:alltest: - scripts/test_wrapper.sh src/lib_signer_backends signer_backends - scripts/test_wrapper.sh src/lib_signer_backends/unix signer_backends_unix - scripts/test_wrapper.sh src/lib_stdlib stdlib - - scripts/test_wrapper.sh src/lib_stdlib_unix stdlib_unix - scripts/test_wrapper.sh src/lib_storage storage - scripts/test_wrapper.sh src/proto_006_PsCARTHA/lib_client 006_PsCARTHA_lib_client - scripts/test_wrapper.sh src/proto_007_PsDELPH1/lib_client 007_PsDELPH1_lib_client diff --git a/scripts/version.sh b/scripts/version.sh index 1028a4a82929..4f9177a3cf49 100755 --- a/scripts/version.sh +++ b/scripts/version.sh @@ -13,7 +13,7 @@ recommended_rust_version=1.44.0 full_opam_repository_tag=bf94421703ae6d95113e5b24890f304701e47b78 ## opam_repository is an additional, tezos-specific opam repository. -opam_repository_tag=4eb9728016e05758054c600ddc66c7e295c27a26 +opam_repository_tag=8312444f0f524f5456cdf3660328b6bbffd0107c opam_repository_url=https://gitlab.com/tezos/opam-repository.git opam_repository=$opam_repository_url\#$opam_repository_tag diff --git a/src/bin_node/dune b/src/bin_node/dune index 0c033582e2bd..3b897f103b58 100644 --- a/src/bin_node/dune +++ b/src/bin_node/dune @@ -75,7 +75,8 @@ (tezos-mempool-008-PtEdoTez -> void_for_linking-008-PtEdoTez-mempool.empty) (-> void_for_linking-008-PtEdoTez-mempool.empty)) cmdliner - tls) + tls + lwt-exit) (flags (:standard -open Tezos_base__TzPervasives -open Tezos_base -open Tezos_stdlib_unix diff --git a/src/bin_node/tezos-node.opam b/src/bin_node/tezos-node.opam index d6630c495e43..56947a0baa4b 100644 --- a/src/bin_node/tezos-node.opam +++ b/src/bin_node/tezos-node.opam @@ -35,6 +35,7 @@ depends: [ "tezos-mempool-007-PsDELPH1" "tezos-mempool-008-PtEdoTez" "cmdliner" + "lwt-exit" "tls" { >= "0.10" < "0.11" } # remove the upper bond when the compatibility with hacl-star is restored "cstruct" ] diff --git a/src/bin_validation/tezos-validator.opam b/src/bin_validation/tezos-validator.opam index 307726d6d3aa..363eba761879 100644 --- a/src/bin_validation/tezos-validator.opam +++ b/src/bin_validation/tezos-validator.opam @@ -15,6 +15,7 @@ depends: [ "tezos-shell" "tezos-shell-context" "tezos-validation" + "lwt-exit" ] build: [ [ "dune" "build" "-p" name "-j" jobs ] diff --git a/src/lib_client_base_unix/dune b/src/lib_client_base_unix/dune index 4fb49fac0986..f74dded3eeed 100644 --- a/src/lib_client_base_unix/dune +++ b/src/lib_client_base_unix/dune @@ -11,7 +11,8 @@ tezos-mockup-commands tezos-proxy tezos-signer-backends.unix - tezos-shell-services) + tezos-shell-services + lwt-exit) (flags (:standard -open Tezos_base__TzPervasives -open Tezos_rpc_http -open Tezos_rpc_http_client_unix diff --git a/src/lib_client_base_unix/tezos-client-base-unix.opam b/src/lib_client_base_unix/tezos-client-base-unix.opam index 07e34c3adb8e..9416381d0568 100644 --- a/src/lib_client_base_unix/tezos-client-base-unix.opam +++ b/src/lib_client_base_unix/tezos-client-base-unix.opam @@ -17,6 +17,7 @@ depends: [ "tezos-mockup-registration" "tezos-mockup-commands" "tezos-proxy" + "lwt-exit" ] build: [ ["dune" "build" "-p" name "-j" jobs] diff --git a/src/lib_protocol_updater/dune b/src/lib_protocol_updater/dune index 390484a760bb..7aa1fa3b6b25 100644 --- a/src/lib_protocol_updater/dune +++ b/src/lib_protocol_updater/dune @@ -10,6 +10,7 @@ tezos-protocol-compiler.registerer tezos-protocol-compiler.native tezos-storage + lwt-exit dynlink) (flags (:standard -open Tezos_base__TzPervasives -open Tezos_stdlib_unix diff --git a/src/lib_protocol_updater/tezos-protocol-updater.opam b/src/lib_protocol_updater/tezos-protocol-updater.opam index c3114659a4a1..d06d1f265819 100644 --- a/src/lib_protocol_updater/tezos-protocol-updater.opam +++ b/src/lib_protocol_updater/tezos-protocol-updater.opam @@ -15,6 +15,7 @@ depends: [ "tezos-shell-context" "tezos-stdlib-unix" "tezos-storage" + "lwt-exit" ] build: [ ["dune" "build" "-p" name "-j" jobs] diff --git a/src/lib_shell/dune b/src/lib_shell/dune index 774a2b4dfe19..c93f2c9fbd7e 100644 --- a/src/lib_shell/dune +++ b/src/lib_shell/dune @@ -14,7 +14,8 @@ tezos-protocol-updater tezos-requester tezos-workers - tezos-validation) + tezos-validation + lwt-exit) (flags (:standard -open Tezos_base__TzPervasives -open Tezos_base -open Tezos_storage diff --git a/src/lib_shell/tezos-shell.opam b/src/lib_shell/tezos-shell.opam index 98cbad0fdc18..3efb5e9dbe20 100644 --- a/src/lib_shell/tezos-shell.opam +++ b/src/lib_shell/tezos-shell.opam @@ -19,6 +19,7 @@ depends: [ "tezos-requester" "lwt-watcher" { = "0.1" } "lwt-canceler" { = "0.2" } + "lwt-exit" "alcotest-lwt" { with-test & >= "1.1.0" } "crowbar" { with-test } "tezos-workers" diff --git a/src/lib_stdlib_unix/lwt_exit.ml b/src/lib_stdlib_unix/lwt_exit.ml deleted file mode 100644 index 57ccc252281f..000000000000 --- a/src/lib_stdlib_unix/lwt_exit.ml +++ /dev/null @@ -1,501 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -(* 1. clean-up callback registration/unregistration *) - -(* Identifiers are used for unregistering clean-up callbacks *) -type clean_up_callback_id = int - -let clean_up_callback_id_counter = ref min_int - -let new_clean_up_callback_id () = - incr clean_up_callback_id_counter ; - !clean_up_callback_id_counter - -(* clean-up callbacks are stored in a reference to a map *) -module Callbacks_map = Map.Make (Int) - -type callback = { - callback : int -> unit Lwt.t; - after : clean_up_callback_id list; - loc : string; -} - -let clean_up_callbacks : callback Callbacks_map.t ref = ref Callbacks_map.empty - -(* adding and removing clean-up callbacks affects the global reference map *) -let register_clean_up_callback ?(after = []) ~loc callback = - let id = new_clean_up_callback_id () in - let callback = {callback; after; loc} in - clean_up_callbacks := Callbacks_map.add id callback !clean_up_callbacks ; - id - -let unregister_clean_up_callback id = - clean_up_callbacks := Callbacks_map.remove id !clean_up_callbacks - -(* 2. clean-up *) - -(* cleaning-up is just calling all the clean-up callbacks, note that the - function is not exported: it cannot be called directly, it can only be - triggered as a side effect to calling [exit_and_raise] or [exit_and_wait] - - Returns a seq of clean-up promises along with their identifiers. *) -let clean_up status = - (* NOTE: [to_seq] iterates in increasing order of keys *) - let callbacks = Callbacks_map.to_seq !clean_up_callbacks in - clean_up_callbacks := Callbacks_map.empty ; - let promises : (string * unit Lwt.t) Callbacks_map.t = - Seq.fold_left - (fun promises (id, {callback; after; loc}) -> - let pre = - match after with - | [] -> - Lwt.return_unit - | _ :: _ as after -> ( - match - Callbacks_map.fold - (fun id (_, p) ps -> if List.mem id after then p :: ps else ps) - promises - [] - with - | [] -> - (* This can happen if all after-callbacks were unregistered *) - Lwt.return_unit - | [p] -> - p - | _ :: _ :: _ as ps -> - Lwt.join ps ) - in - let promise = pre >>= fun () -> callback status in - Lwt.on_failure promise (fun exc -> - Format.eprintf - "(%s) Exit: uncaught exception during clean-up (%s): %s\n%!" - Sys.executable_name - loc - (Printexc.to_string exc)) ; - Callbacks_map.add id (loc, promise) promises) - Callbacks_map.empty - callbacks - in - Seq.map snd @@ Callbacks_map.to_seq promises - -(* 3. synchronisation primitives *) - -(* [clean_up_starts] an exported promise that resolves when the clean-up starts. - [start_clean_up] a non-exported resolver for the promise. - - Note that the promise is not cancelable and we never pass an exception to the - resolver. Consequently, the promise cannot be rejected. *) -let (clean_up_starts_internal, start_clean_up) = Lwt.wait () - -(* [clean_up_starts] is exported with a delay to ensure that [wrap_and_*] - function witness the start of the cleaning up before users of the library. *) -let clean_up_starts = - Lwt.no_cancel - ( clean_up_starts_internal - >>= fun v -> Lwt.pause () >>= fun () -> Lwt.return v ) - -let clean_up_promises = - clean_up_starts_internal >>= fun status -> Lwt.return @@ clean_up status - -(* [clean_up_ends] is a promise that resolves once the clean-up is finished. *) -let clean_up_ends = - clean_up_starts_internal - >>= fun status -> - clean_up_promises - >>= fun promises -> - Lwt.join @@ List.of_seq - @@ Seq.map - (fun (_, promise) -> - Lwt.try_bind - (fun () -> promise) - (fun () -> Lwt.return_unit) - (fun _ -> Lwt.return_unit)) - promises - >>= fun () -> Lwt.return status - -(* 4. exiting *) - -(* simple exit is not exported, it is just to factor out exiting *) -let exit n = - match Lwt.state clean_up_starts_internal with - | Sleep -> - Lwt.wakeup start_clean_up n - | Return _ -> - () - | Fail _ -> - (* Remember [clean_up_starts_internal] cannot be rejected. *) - assert false - -(* [exit_and_raise] is meant to be used deep inside the program after having - witnessed, say, a fatal error. It raises an exception so that it can be used - anywhere in the program. *) -let exit_and_raise n = exit n ; raise Exit - -(* [exit_and_wait] is meant to be used near the main invocation of the program, - right inside of [Lwt_main.run] but presumably after [wrap_and_error]. *) -let exit_and_wait n = exit n ; clean_up_ends - -(* exit codes *) - -let incomplete_clean_up_mask = 128 - -let signal_exit_code = 127 - -let uncaught_exception_exit_code = 126 - -let mask_code_bc_incomplete_clean_up code = code lor incomplete_clean_up_mask - -let mask_code_if_incomplete_clean_up ~complete:all_fine code = - if all_fine then code else mask_code_bc_incomplete_clean_up code - -(* 5. signals *) - -type signal_setup = {soft : (int * string) list; hard : (int * string) list} - -(** Known signals and their names *) -let all_signal_names = - let open Sys in - [ (sigabrt, "ABRT"); - (sigalrm, "ALRM"); - (sigfpe, "FPE"); - (sighup, "HUP"); - (sigill, "ILL"); - (sigint, "INT"); - (sigkill, "KILL"); - (sigpipe, "PIPE"); - (sigquit, "QUIT"); - (sigsegv, "SEGV"); - (sigterm, "TERM"); - (sigusr1, "USR1"); - (sigusr2, "USR2"); - (sigchld, "CHLD"); - (sigcont, "CONT"); - (sigstop, "STOP"); - (sigtstp, "TSTP"); - (sigttin, "TTIN"); - (sigttou, "TTOU"); - (sigvtalrm, "VTALRM"); - (sigprof, "PROF"); - (sigbus, "BUS"); - (sigpoll, "POLL"); - (sigsys, "SYS"); - (sigtrap, "TRAP"); - (sigurg, "URG"); - (sigxcpu, "XCPU"); - (sigxfsz, "XFSZ") ] - -(** recovering the name of a signal *) -let signal_name signal = - match List.assoc_opt signal all_signal_names with - | Some name -> - name - | None -> - Format.asprintf "%d" signal - -let make_signal_setup ~soft ~hard = - try - let soft = List.map (fun signal -> (signal, signal_name signal)) soft in - let hard = List.map (fun signal -> (signal, signal_name signal)) hard in - {soft; hard} - with Not_found -> raise (Invalid_argument "Lwt_exit.make_signal_setup") - -let default_signal_setup = - make_signal_setup ~soft:[Sys.sigint; Sys.sigterm] ~hard:[] - -let sleep_span s = Lwt_unix.sleep (Ptime.Span.to_float_s s) - -let set_already_received_once double_signal_safety already_received_once name = - if Ptime.Span.(equal double_signal_safety zero) then ( - Format.eprintf - "(%s) %s: send signal again to force-quit.\n%!" - Sys.executable_name - name ; - already_received_once := true ) - else - Lwt_utils.dont_wait - (fun _exc -> assert false) - (fun () -> - (* Wait one second for safety, then set force-quitting *) - sleep_span double_signal_safety - >>= fun () -> - Format.eprintf - "(%s) %s: send signal again to force-quit.\n%!" - Sys.executable_name - name ; - already_received_once := true ; - Lwt.return_unit) - -let default_double_signal_safety = Option.get @@ Ptime.Span.of_float_s 1.0 - -(* soft handling: trigger an exit on first signal, immediately terminate - process on second signal *) -let set_soft_handler ?(double_signal_safety = default_double_signal_safety) - signal name = - let already_received_once = ref false in - Lwt_unix.on_signal signal (fun _signal -> - if !already_received_once then ( - Format.eprintf - "(%s) %s: signal received again, forcing immediate termination.\n%!" - Sys.executable_name - name ; - Stdlib.exit (mask_code_bc_incomplete_clean_up signal_exit_code) ) - else - match Lwt.state clean_up_starts_internal with - | Sleep -> - Format.eprintf - "(%s) %s: triggering shutdown.\n%!" - Sys.executable_name - name ; - exit signal_exit_code ; - set_already_received_once - double_signal_safety - already_received_once - name - | Return _ -> - Format.eprintf - "(%s) %s: already in shutdown.\n%!" - Sys.executable_name - name ; - set_already_received_once - double_signal_safety - already_received_once - name - | Fail _ -> - (* Remember [clean_up_starts_internal] cannot be rejected. *) - assert false) - -(* hard handling: immediately terminate process *) -let set_hard_handler signal name = - Lwt_unix.on_signal signal (fun _signal -> - Format.eprintf "(%s) %s: force-quiting.\n%!" Sys.executable_name name ; - Stdlib.exit (mask_code_bc_incomplete_clean_up signal_exit_code)) - -let setup_signal_handlers ?double_signal_safety signal_setup = - let soft_handler_ids = - List.fold_left - (fun acc (signal, name) -> - set_soft_handler ?double_signal_safety signal name :: acc) - [] - signal_setup.soft - in - let all_handler_ids = - List.fold_left - (fun acc (signal, name) -> set_hard_handler signal name :: acc) - soft_handler_ids - signal_setup.hard - in - all_handler_ids - -let unset_handlers = List.iter Lwt_unix.disable_signal_handler - -(* 6. internal synchronisation *) - -let wait_for_clean_up max_clean_up_time = - ( match Lwt.state clean_up_starts_internal with - | Return _ -> - () - | Fail _ -> - (* Remember [clean_up_starts_internal] cannot be rejected. *) - assert false - | Sleep -> - (* We only call this function after the clean-up has started, and we do - not export the function *) - assert false ) ; - Lwt.pause () - >>= fun () -> - ( match Lwt.state clean_up_promises with - | Return _ -> - () - | Fail _ -> - (* the promises are a promise that cannot be rejected *) - assert false - | Sleep -> - (* One tick after the clean-up has started, all the promises have been - collected. *) - assert false ) ; - ( match Lwt.state clean_up_ends with - | Fail _ -> - assert false - | Return _ -> - (* This happens when there are no callbacks registered: the clean-up is - immediate. *) - Lwt.return_unit - | Sleep -> ( - match max_clean_up_time with - | None -> - (* without timeout: just wait *) - clean_up_ends >>= fun _ -> Lwt.return_unit - | Some s -> - (* with timeout: pick first to finish *) - Lwt.choose [(clean_up_ends >>= fun _ -> Lwt.return_unit); sleep_span s] - ) ) - (* pause in case timeout and clean-up needs to deal with cancellation *) - >>= Lwt.pause - >|= fun () -> - match Lwt.state clean_up_promises with - | Lwt.Sleep -> - (* we have already asserted this earlier in the function *) - assert false - | Lwt.Fail _ -> - (* we have already asserted this earlier in the function *) - assert false - | Lwt.Return promises -> - (* check (and log) whether all clean-up is done successfully *) - Seq.fold_left - (fun all_fine (id, promise) -> - match Lwt.state promise with - | Lwt.Sleep -> - (* if a promise has not been given enough time to resolve, then it - means it was interupted by a timeout: [max_clean_up_time] *) - assert (max_clean_up_time <> None) ; - Format.eprintf - "(%s) Exit: timeout, clean-up callback not terminated (%s)\n%!" - Sys.executable_name - id ; - false - | Lwt.Fail exc -> - Format.eprintf - "(%s) Exit: clean-up callback failed (%s): %s\n%!" - Sys.executable_name - id - (Printexc.to_string exc) ; - false - | Lwt.Return () -> - all_fine) - true - promises - -(* 7. main interface: wrapping promises *) - -(* take a promise and wrap it in `Ok` but also watch for exiting and wrap that - in `Error` *) -let wrap_and_error ?(signal_setup = default_signal_setup) ?double_signal_safety - ?max_clean_up_time p = - ( match Lwt.state clean_up_starts_internal with - | Lwt.Fail _ -> - (* Remember [clean_up_starts_internal] cannot be rejected. *) - assert false - | Lwt.Return _ -> - raise (Invalid_argument "Lwt_exit.wrap") - | Lwt.Sleep -> - () ) ; - match Lwt.state p with - | Lwt.Fail _ | Lwt.Return _ -> - p >>= Lwt.return_ok - | Lwt.Sleep -> - let handler_ids = - setup_signal_handlers ?double_signal_safety signal_setup - in - Lwt.try_bind - (fun () -> - (* Watch out for both [p] and the start of clean-up *) - Lwt.choose - [p >>= Lwt.return_ok; clean_up_starts_internal >>= Lwt.return_error]) - (function - | Ok v -> - (* In this branch, the [Ok] indicates that [p] was resolved before - [clean_up_starts_internal]. As a result, - [clean_up_starts_internal] must still be pending. - - It is only possible for two promises to resolve simultaneously - if they are physically equal, if one is a proxy for the other, - or some other similar situation. Because - [clean_up_starts_internal] is not exported, this is not - possible. *) - assert (Lwt.state clean_up_starts_internal = Lwt.Sleep) ; - unset_handlers handler_ids ; - Lwt.return (Ok v) - | Error status -> - (* Conversely to the previous comment: when - [clean_up_starts_internal] resolves first, then [p] cannot have - resolved yet. *) - assert (Lwt.state clean_up_starts_internal = Lwt.Return status) ; - Lwt.cancel p ; - wait_for_clean_up max_clean_up_time - >>= fun complete -> - unset_handlers handler_ids ; - let status = mask_code_if_incomplete_clean_up ~complete status in - Lwt.return (Error status)) - (function - | Exit -> ( - (* When [Exit] bubbles from the wrapped promise, maybe it called - [exit_and_raise] *) - Lwt.pause () - >>= fun () -> - match Lwt.state clean_up_starts_internal with - | Return status -> - wait_for_clean_up max_clean_up_time - >>= fun complete -> - unset_handlers handler_ids ; - let status = - mask_code_if_incomplete_clean_up ~complete status - in - Lwt.return (Error status) - | Fail _ -> - (* Remember [clean_up_starts_internal] cannot be rejected. *) - assert false - | Sleep -> - exit uncaught_exception_exit_code ; - Format.eprintf - "(%s) Exit: exit because of uncaught exception: %s\n%!" - Sys.executable_name - (Printexc.to_string Exit) ; - wait_for_clean_up max_clean_up_time - >>= fun complete -> - unset_handlers handler_ids ; - let status = - mask_code_if_incomplete_clean_up - ~complete - uncaught_exception_exit_code - in - Lwt.return (Error status) ) - | exc -> - exit uncaught_exception_exit_code ; - Format.eprintf - "(%s) Exit: exit because of uncaught exception: %s\n%!" - Sys.executable_name - (Printexc.to_string exc) ; - wait_for_clean_up max_clean_up_time - >>= fun complete -> - unset_handlers handler_ids ; - let status = - mask_code_if_incomplete_clean_up - ~complete - uncaught_exception_exit_code - in - Lwt.return (Error status)) - -(* same but exit on error *) -let wrap_and_exit ?signal_setup ?double_signal_safety ?max_clean_up_time p = - wrap_and_error ?max_clean_up_time ?double_signal_safety ?signal_setup p - >>= function Ok v -> Lwt.return v | Error status -> Stdlib.exit status - -(* same but just return exit status *) -let wrap_and_forward ?signal_setup ?double_signal_safety ?max_clean_up_time p = - wrap_and_error ?max_clean_up_time ?double_signal_safety ?signal_setup p - >>= function Ok v -> Lwt.return v | Error status -> Lwt.return status diff --git a/src/lib_stdlib_unix/lwt_exit.mli b/src/lib_stdlib_unix/lwt_exit.mli deleted file mode 100644 index c114553cfe63..000000000000 --- a/src/lib_stdlib_unix/lwt_exit.mli +++ /dev/null @@ -1,440 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** {1 [Lwt_exit]} - - [Lwt_exit] provides helpers to handle: - - - OS signals, - - cleaning-up before exiting, and - - exiting. - - Specifically, this module allows users to (1) register clean-up callbacks - and (2) trigger a soft exit. When a soft exit is triggered, the clean-up - callbacks are called. The process exits once all the clean-up callbacks - calls have resolved. *) - -(** {2 State} *) - -(** A global promise that resolves when clean-up starts. Note that there is no - way to "just" start clean-up. Specifically, it is only possible to start the - clean-up as a side-effect of triggering an exit. - - It is safe to use [clean_up_starts], even in the "main" promise. See example - below in {!Misc recommendations}-{!Cleanly interrupting a main loop}. It is - safe because [Lwt_exit] always witnesses the resolution of this promise - before users of the library. -*) -val clean_up_starts : int Lwt.t - -(** A global promise that resolves when clean-up ends. *) -val clean_up_ends : int Lwt.t - -(** {2 Clean-up callbacks} *) - -(** Attaching and detaching callbacks. *) - -type clean_up_callback_id - -(** [register_clean_up_callback f] registers [f] to be called as part of the - clean-up. Typically this is used to flush outputs, rollback/commit pending - changes, gracefully close connections with peers, etc. - - The call to [f] receives an argument [n] that indicates the status the - process will exit with at the end of clean-up: [0] is for success, [127] for - interruption by signals, [126] for uncaught exceptions, other values are - available for the application's own exit codes. - - The argument [after], if passed, delays the call to this clean-up callback - until the clean-up callbacks identified by [after] have resolved. Apart - from this synchronization mechanism, all clean-up callbacks execute eagerly - and concurrently. Note that more complex synchronization is discouraged but - possible via standard Lwt techniques. - - Note that if one of the callbacks identified in [after] is unregistered - (through {!unregister_clean_up_callback}) then it is simply ignored for the - purpose of synchronization. Thus, it is important to indicate all the - "dependencies" of a clean-up callback and not rely on transitive - "dependencies". - - Once clean-up has started, this function has no effect. - - The promise returned by this callback may be canceled if it takes too long - to complete. (See {!max_clean_up_time} below.) *) -val register_clean_up_callback : - ?after:clean_up_callback_id list -> - loc:string -> - (int -> unit Lwt.t) -> - clean_up_callback_id - -(** [unregister_clean_up_callback cid] removes the callback with id [cid] from - the set of functions to call for cleaning up. - - Once clean-up has started, this function has no effect. *) -val unregister_clean_up_callback : clean_up_callback_id -> unit - -(** Example use: - - [let p = open_resource r in - let clean_p = register_clean_up_callback (fun _ -> close_resource p) in - let rec feed () = - read () >>= fun v -> - push_to_resource p >>= fun () -> - feed () - in - feed () >>= fun () -> - close_resource p >>= fun () -> - unregister_clean_up_callback clean_p; - Lwt.return ()] -*) - -(** {2 Exiting} *) - -(** [exit_and_raise n] triggers a soft exit (including clean-up) and raises - {!Stdlib.Exit}. This is intended for use deep inside the program, at a place - that wants to trigger an exit after observing, say, a fatal error. *) -val exit_and_raise : int -> 'a - -(** [exit_and_wait n] triggers a soft exit (including clean-up) and stays - pending until it is finished. This is intended to be used directly within - {!Lwt_main.run} for a clean exit. *) -val exit_and_wait : int -> int Lwt.t - -(** {2 Signal management} *) - -(** A soft signal handler is one that triggers clean-up. - - After the clean-up has started, and after a safety period has elapsed, - sending the same soft-handled signal a second time terminates the - process immediately. The safety period is set by the parameter - [double_signal_safety] of the {!wrap_and_exit}, {!wrap_and_error}, and - {!wrap_and_forward} functions (below). - - A hard signal handler is one that terminates the process immediately. - - IMPORTANT: a hard exit can leave open files in inconsistent states. *) - -type signal_setup - -(** [make_signal_setup ~soft ~hard] is a signal setup with [soft] as soft - signals and [hard] as hard signals. - - @raise {!Stdlib.Invalid_argument} if a signal is not one declared in {!Sys} - (see all [Sys.sig*] values). *) -val make_signal_setup : soft:int list -> hard:int list -> signal_setup - -(** [default_signal_setup] is - [make_signal_setup ~soft:[Sys.sigint; Sys.sigterm] ~hard:[]]. - - Note that pressing Ctrl-C sends [SIGINT] to the process whilst shutting it - down through systemd sends [SIGTERM]. This is the reasoning behind the - default: both of those signals should be handled softly in most cases. *) -val default_signal_setup : signal_setup - -(** [signal_name signal] is the name of [signal]. - E.g., [signal_name Sys.sigterm] is ["TERM"]. *) -val signal_name : int -> string - -(** {2 Main promise wrappers} *) - -(** [wrap_and_exit p] is a promise [q] that behaves as follows: - - NORMAL OPERATION: - - If [p] is fulfilled with value [v] (and [exit_and_raise] was not called) - then - - [q] also is fulfilled with [v]. The process does not exit. - - If [exit_and_raise code] is called before [p] is resolved, then - - the clean-up starts, - - [p] is canceled, - - the process terminates as soon as clean-up ends with exit code [code]. - - If [p] is rejected (and [exit_and_raise] was not called), it is equivalent - to calling [exit_and_raise 126]. I.e., - - the clean-up starts, - - the process terminates as soon as clean-up ends with exit code [126]. - - EXIT CODE: - - The exit code of the process is masked with [lor 128] (i.e., setting the 8th - bit) if the clean-up did not complete successfully (i.e., if any of the - clean-up callbacks were rejected). - - E.g., if you call [exit_and_raise 1] and one of the clean-up callback fails - (is rejected with an exception), then the exit code is [1 lor 128 = 129]. - - Note that even if one clean-up callback fails, the other clean-up callbacks - are left to execute. - - SIGNALS: - - In addition, [wrap_and_exit p] sets up the signal handlers described above - (see {!signal_setup}). - - Any hard-signal that is received triggers an immediate process termination - with exit code [127 lor 128 = 255]. - - Any soft-signal that is received triggers a call to [exit_and_raise 127] - (the consequences of which are described above). - - Note that if the same soft-signal is sent a second-time, the process - terminates immediately with code [127 lor 128 = 255]. - - To summarize, the exit code can be thought of as a 8-bit integer with the - following properties: - - the highest bit is set if the clean-up was unsuccessful/incomplete - - the second highest bit is set if the process exited because of a signal - - the third highest bit is set if the process exited because of an uncaught - exception - - all other bits can be used by the application as wanted. - - Note that if the second (signal) or third (exception) highest bits are set, - then only the highest (incomplete clean-up) may also be set. - - EXCEPTIONS: - - @raise {!Invalid_argument} if called after clean-up has already started. See - {!Misc recommendations}({!One-shot}) below for details about the - consequences of this. - - OPTIONAL PARAMETERS: - - The optional argument [max_clean_up_time] limits the time the clean-up phase - is allowed to run for. If any of the clean-up callbacks is still pending - when [max_clean_up_time] has elapsed, the process exits immediately. If the - clean-up is interrupted by this then the exit code is masked with [128] as - described above. - - By default [max_clean_up_time] is not set and no limits is set for the - completion of the clean-up callbacks. - - The optional argument [double_signal_safety] (defaults to one (1) second) - is the grace period after sending one of the softly-handled signal before - sending the same signal is handled as hard. - - This is meant to protect against double-pressing Ctrl-C in an interactive - terminal session. If you press Ctrl-c once, a soft exit is triggered, if you - press it again (accidentally) within the grace period it is ignored, if you - press it again after the grace period has elapsed it is treated as a hard - exit. - - The optional argument [signal_setup] (defaults to [default_signal_setup]) - sets up soft and hard handlers at the beginning and clears them when [q] - resolves. - - EXAMPLE: - - Intended use: - [Stdlib.exit @@ Lwt_main.run begin - Lwt_exit.wrap_and_exit (init ()) >>= fun v -> - let ccbid_v = register_clean_up_callback ~loc:__LOC__ (fun _ -> clean v) in - Lwt_exit.wrap_and_exit (main v) >>= fun r -> - let () = unregister_clean_up_callback ccbid_v in - let ccbid_r = register_clean_up_callback ~loc:__LOC__ (fun _ -> free r) in - Lwt_exit.wrap_and_exit (shutdown v) >>= fun () -> - exit_and_wait 0 (* clean exit afterwards *) - end] -*) -val wrap_and_exit : - ?signal_setup:signal_setup -> - ?double_signal_safety:Ptime.Span.t -> - ?max_clean_up_time:Ptime.Span.t -> - 'a Lwt.t -> - 'a Lwt.t - -(** [wrap_and_error p] is similar to {!wrap_and_exit} [p] but it resolves to - [Error status] instead of exiting with [status]. When it resolves with - [Error _] (i.e., if a soft-exit has been triggered), clean-up has already - ended. - - Intended use: - [Stdlib.exit @@ Lwt_main.run begin - Lwt_exit.wrap_and_error (init ()) >>= function - | Error exit_status -> - Format.eprintf "Initialisation failed\n%!"; - Lwt.return exit_status - | Ok v -> - Lwt_exit.wrap_and_error (main v) >>= function - | Error exit_status -> - Format.eprintf "Processing failed\n%!"; - Lwt.return exit_status - | Ok v -> - Lwt_exit.wrap_and_error (shutdown ()) >>= function - | Error exit_status -> - Format.eprintf "Shutdown failed\n%!"; - Lwt.return exit_status - | Ok () -> - exit_and_wait 0 >>= fun _ -> - Lwt.return 0 - end] -*) -val wrap_and_error : - ?signal_setup:signal_setup -> - ?double_signal_safety:Ptime.Span.t -> - ?max_clean_up_time:Ptime.Span.t -> - 'a Lwt.t -> - ('a, int) result Lwt.t - -(** [wrap_and_forward p] is similar to {!wrap_and_error} [p] except that it - collapses [Ok _] and [Error _]. - - Note that, in general, you can expect the status [0] to come from a - successfully resolved [p]. However, It could also be because of a soft-exit - with status [0]. As a result, you cannot be certain, based on the status - alone, whether clean-up callbacks have been called. - - Intended use: - [Stdlib.exit @@ Lwt_main.run begin - Lwt_exit.wrap_and_forward (main ()) >>= function - | 0 -> - Format.printf "I'm done, bye!\n%!"; - Lwt.return 0 - | 1 -> (* signaling *) - Format.printf "Shutdown complete\n"; - Lwt.return 1 - | 2 -> (* uncaught exception *) - Format.printf "An error occurred.\n"; - Format.printf "Please check %s\n" log_file; - Format.printf "And consider reporting the issue\n%!"; - Lwt.return 2 - | _ -> assert false - end] -*) -val wrap_and_forward : - ?signal_setup:signal_setup -> - ?double_signal_safety:Ptime.Span.t -> - ?max_clean_up_time:Ptime.Span.t -> - int Lwt.t -> - int Lwt.t - -(** {2 Misc recommendations} - - {3 One-shot} - - [Lwt_exit] is one-shot: once the clean-up has started, further uses of - [wrap_and_*] will raise {!Invalid_argument}. - - Note, for example, how in the {!wrap_and_error} example, [wrap_and_error] is - called multiple time, but on [Ok] branches where clean-up has {e not} - happened. This is ok. - - On the other hand, using [wrap_and_error] in an [Error] branch would be - unsound because clean-up has happened in these branches. - - {3 Registering callbacks} - - To the extent that it is possible, you should register your clean-up callbacks - as soon as a resource that needs clean-up is allocated. - - [let r = in - let c = register_clean_up_callback ~loc:__LOC__ (fun s -> ) in - ; - let () = unregister_clean_up_callback c in - ; - - ] - - When possible, you can even register the callback before-hand. - - [let rr = ref None in - let c = register_clean_up_callback - ~loc:__LOC__ - (fun s -> Option.iter (fun r -> ) !rr) - in - let rr := Some in - ; - let () = unregister_clean_up_callback c in - rr := None; - ; - - ] - - {3 Registering, unregistering, and loops} - - In a tight-loop, in the event loop of an actor, etc. avoid registering and - unregistering clean-up callbacks repeatedly. Instead, you should create an - intermediate layer dedicated to clean-up. E.g., - - [let module Resources = Set.Make() in - let rs = ref Resources.empty in - let c = register_clean_up_callback - ~loc:__LOC__ - (fun s -> Resources.iter - (fun r -> ; Lwt.return ()) - !rs) - in - let rec loop () = - receive () >>= function - | End -> Lwt.return () - | Input input -> - let _process = - let r = in - rs := Resources.add r !rs; - >>= fun () -> - rs := Resources.remove r !rs; - ; - Lwt.return () - in - loop () - in - loop () - ] - - Note that this is a general example and your specific use would differ. - - More importantly, note that in this specific case we do not unregister the - clean-up callback because there is no point at which we know that the resource - set is empty. It's ok because the clean-up will be a very fast no-op. Coming - up with a solution that allows unregistering of the clean-up callback is left - as an exercise to the reader. - - {3 Cleanly interrupting a main loop} - - In a program that does not normally exit, you might want to interrupt the main - loop (to avoid further processing) as soon as clean-up has started (either - because a signal was received or because a fatal exception deep within the - program was handled by calling {!exit_and_raise}). - - This is easily achieved by passing the main-loop to [wrap_and_*]. As - mentioned in the documentation of {!wrap_and_exit}, the promise passed as - argument is cancelled as soon as the clean-up starts. - - However, there may be other loops that are not syntactically available to the - main wrapper. In this case, the simple pattern below is safe and the loop, - provided it is cancelable, will stop when the clean-up starts. - - [let rec loop () = - get_task () >>= fun task -> - process task >>= fun () -> - loop () - in - Lwt.pick [loop (); Lwt_exit.clean_up_starts]] - - Arguably, for such a simple case, you can replace the pattern above by a - simple clean-up callback that cancels the loop. However, for more complex - arrangements, the [pick]-with-[clean_up_starts] pattern above can be useful. - -*) diff --git a/src/lib_stdlib_unix/test/.ocamlformat b/src/lib_stdlib_unix/test/.ocamlformat deleted file mode 100644 index 8278a132e3d6..000000000000 --- a/src/lib_stdlib_unix/test/.ocamlformat +++ /dev/null @@ -1,12 +0,0 @@ -version=0.10 -wrap-fun-args=false -let-binding-spacing=compact -field-space=loose -break-separators=after-and-docked -sequence-style=separator -doc-comments=before -margin=80 -module-item-spacing=sparse -parens-tuple=always -parens-tuple-patterns=always -break-string-literals=newlines-and-wrap diff --git a/src/lib_stdlib_unix/test/dune b/src/lib_stdlib_unix/test/dune deleted file mode 100644 index 8a4d4e07d415..000000000000 --- a/src/lib_stdlib_unix/test/dune +++ /dev/null @@ -1,122 +0,0 @@ -(executables - (names - test_lwt_exit_after - test_lwt_exit_clean_up - test_lwt_exit_clean_up_failure - test_lwt_exit_clean_up_timeout - test_lwt_exit_exit - test_lwt_exit_exit_escape - test_lwt_exit_raise - test_lwt_exit_raise_exit - test_lwt_exit_range_of_signals - test_lwt_exit_return - test_lwt_exit_signal - test_lwt_exit_unregister_clean_up - test_lwt_exit_unregister_clean_up_with_after - test_lwt_exit_main_is_clean_up - ) - (libraries tezos-stdlib-unix - tezos-stdlib - lwt.unix) - (flags (:standard -open Tezos_stdlib_unix))) - -(alias - (name buildtest) - (deps - test_lwt_exit_after.exe - test_lwt_exit_clean_up.exe - test_lwt_exit_clean_up_failure.exe - test_lwt_exit_clean_up_timeout.exe - test_lwt_exit_exit_escape.exe - test_lwt_exit_exit.exe - test_lwt_exit_raise.exe - test_lwt_exit_raise_exit.exe - test_lwt_exit_range_of_signals.exe - test_lwt_exit_return.exe - test_lwt_exit_signal.exe - test_lwt_exit_unregister_clean_up.exe - test_lwt_exit_unregister_clean_up_with_after.exe - test_lwt_exit_main_is_clean_up.exe - )) - -(rule - (alias runtest_lwt_exit_exit) - (action (run %{exe:test_lwt_exit_exit.exe}))) - -(rule - (alias runtest_lwt_exit_exit_escape) - (action (run %{exe:test_lwt_exit_exit_escape.exe}))) - -(rule - (alias runtest_lwt_exit_return) - (action (run %{exe:test_lwt_exit_return.exe}))) - -(rule - (alias runtest_lwt_exit_after) - (action (run %{exe:test_lwt_exit_after.exe}))) - -(rule - (alias runtest_lwt_exit_signal) - (action (run %{exe:test_lwt_exit_signal.exe}))) - -(rule - (alias runtest_lwt_exit_clean_up) - (action (run %{exe:test_lwt_exit_clean_up.exe}))) - -(rule - (alias runtest_test_lwt_exit_unregister_clean_up) - (action (run %{exe:test_lwt_exit_unregister_clean_up.exe}))) - -(rule - (alias runtest_test_lwt_exit_unregister_clean_up_with_after) - (action (run %{exe:test_lwt_exit_unregister_clean_up_with_after.exe}))) - -(rule - (alias runtest_test_lwt_exit_main_is_clean_up) - (action (run %{exe:test_lwt_exit_main_is_clean_up.exe}))) - -(rule - (alias runtest_test_lwt_exit_raise) - (action (run %{exe:test_lwt_exit_raise.exe}))) - -(rule - (alias runtest_test_lwt_exit_raise_exit) - (action (run %{exe:test_lwt_exit_raise_exit.exe}))) - -(rule - (alias runtest_test_lwt_exit_range_of_signals) - (action (run %{exe:test_lwt_exit_range_of_signals.exe}))) - -(rule - (alias runtest_test_lwt_exit_clean_up_failure) - (action (run %{exe:test_lwt_exit_clean_up_failure.exe}))) - -(rule - (alias runtest_test_lwt_exit_clean_up_timeout) - (action (run %{exe:test_lwt_exit_clean_up_timeout.exe}))) - -(alias - (name runtest) - (package tezos-stdlib-unix) - (deps - (alias runtest_lwt_exit_after) - (alias runtest_lwt_exit_clean_up) - (alias runtest_lwt_exit_exit) - (alias runtest_lwt_exit_exit_escape) - (alias runtest_lwt_exit_return) - (alias runtest_lwt_exit_signal) - (alias runtest_test_lwt_exit_clean_up_failure) - (alias runtest_test_lwt_exit_clean_up_timeout) - (alias runtest_test_lwt_exit_raise) - (alias runtest_test_lwt_exit_raise_exit) - (alias runtest_test_lwt_exit_range_of_signals) - (alias runtest_test_lwt_exit_unregister_clean_up) - (alias runtest_test_lwt_exit_unregister_clean_up_with_after) - (alias runtest_test_lwt_exit_main_is_clean_up) - ) -) - -(rule - (alias runtest_lint) - (deps (glob_files *.ml{,i})) - (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_after.ml b/src/lib_stdlib_unix/test/test_lwt_exit_after.ml deleted file mode 100644 index 92a115abfbc6..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_after.ml +++ /dev/null @@ -1,65 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -let r = ref 0 - -let first = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - Lwt_unix.sleep 0.2 - >>= fun () -> - assert (!r = 0) ; - incr r ; - Lwt.return_unit) - -let second = - Lwt_exit.register_clean_up_callback ~after:[first] ~loc:__LOC__ (fun _ -> - Lwt_unix.sleep 0.1 - >>= fun () -> - assert (!r = 1) ; - incr r ; - Lwt.return_unit) - -let _third = - Lwt_exit.register_clean_up_callback ~after:[second] ~loc:__LOC__ (fun _ -> - assert (!r = 2) ; - incr r ; - Lwt.return_unit) - -let () = - match - Lwt_main.run - @@ Lwt_exit.wrap_and_error - (let (_ : unit Lwt.t) = - Lwt_unix.sleep 0.1 >>= fun () -> Lwt_exit.exit_and_raise 3 - in - fst @@ Lwt.task ()) - with - | Ok _ -> - assert false - | Error _ -> - assert (!r = 3) ; - exit 0 diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_clean_up.ml b/src/lib_stdlib_unix/test/test_lwt_exit_clean_up.ml deleted file mode 100644 index 59489331790c..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_clean_up.ml +++ /dev/null @@ -1,48 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -let r = ref 0 - -let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun s -> - Lwt_unix.sleep 0.01 - >>= fun () -> - r := s ; - Lwt.return_unit) - -let () = - match - Lwt_main.run - @@ Lwt_exit.wrap_and_error - (Lwt_unix.sleep 0.01 >>= fun () -> Lwt_exit.exit_and_raise 10) - with - | Error 10 -> - assert (!r = 10) - | Error _ -> - assert false - | Ok _ -> - assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_clean_up_failure.ml b/src/lib_stdlib_unix/test/test_lwt_exit_clean_up_failure.ml deleted file mode 100644 index 07388b44d05f..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_clean_up_failure.ml +++ /dev/null @@ -1,56 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -let () = - let devnull = Lwt_main.run (Lwt_unix.openfile "/dev/null" [O_WRONLY] 0) in - Lwt_unix.dup2 devnull Lwt_unix.stderr - -let r = ref 0 - -let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - Lwt_unix.sleep 0.01 >>= fun () -> incr r ; Lwt.return_unit) - -let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - Lwt_unix.sleep 0.03 >>= fun () -> incr r ; Lwt.return_unit) - -let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - Lwt_unix.sleep 0.02 >>= fun () -> raise Not_found) - -let () = - match - Lwt_main.run - @@ Lwt_exit.wrap_and_error - (Lwt_unix.sleep 0.01 >>= fun () -> Lwt_exit.exit_and_raise 10) - with - | Error s -> - assert (!r = 2) ; - assert (s = 10 lor 128) - | Ok _ -> - assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_clean_up_timeout.ml b/src/lib_stdlib_unix/test/test_lwt_exit_clean_up_timeout.ml deleted file mode 100644 index 24558859b404..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_clean_up_timeout.ml +++ /dev/null @@ -1,57 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -let () = - let devnull = Lwt_main.run (Lwt_unix.openfile "/dev/null" [O_WRONLY] 0) in - Lwt_unix.dup2 devnull Lwt_unix.stderr - -let r = ref 0 - -let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - Lwt_unix.sleep 0.01 >>= fun () -> incr r ; Lwt.return_unit) - -let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - Lwt_unix.sleep 0.02 >>= fun () -> incr r ; Lwt.return_unit) - -let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - Lwt_unix.sleep 0.1 >>= fun () -> incr r ; Lwt.return_unit) - -let () = - match - Lwt_main.run - @@ Lwt_exit.wrap_and_error - ~max_clean_up_time:(Option.get @@ Ptime.Span.of_float_s 0.05) - (Lwt_unix.sleep 0.01 >>= fun () -> Lwt_exit.exit_and_raise 10) - with - | Error s -> - assert (!r = 2) ; - assert (s = 10 lor 128) - | Ok _ -> - assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_exit.ml b/src/lib_stdlib_unix/test/test_lwt_exit_exit.ml deleted file mode 100644 index 05c32e2cd7f0..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_exit.ml +++ /dev/null @@ -1,40 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -let () = - match - Lwt_main.run - @@ Lwt_exit.wrap_and_error - ( Lwt.pause () - >>= fun () -> - (try Lwt_exit.exit_and_raise 3 with Exit -> ()) ; - Tezos_stdlib.Lwt_utils.never_ending () ) - with - | Error 3 -> - () - | Error _ | Ok () -> - assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_exit_escape.ml b/src/lib_stdlib_unix/test/test_lwt_exit_exit_escape.ml deleted file mode 100644 index dbee594576dd..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_exit_escape.ml +++ /dev/null @@ -1,42 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -(** Even when not caught, a call to [exit_and_raise] should propagate the - error code correctly. *) -let () = - match - Lwt_main.run - @@ Lwt_exit.wrap_and_error - ( Lwt.pause () - >>= fun () -> - Lwt_exit.exit_and_raise 3 - >>= fun () -> Tezos_stdlib.Lwt_utils.never_ending () ) - with - | Error 3 -> - () - | Error _ | Ok () -> - assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_main_is_clean_up.ml b/src/lib_stdlib_unix/test/test_lwt_exit_main_is_clean_up.ml deleted file mode 100644 index 1251716fdba0..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_main_is_clean_up.ml +++ /dev/null @@ -1,186 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** This series of tests is to check the behaviour of the library in the cases - where the "main" promise resolves "at the same time as" the start of the - clean-up. - - Because the Lwt-exit library assumes that the two promises cannot be - resolved simultaneously, this series of tests attempts to break that - assumption. *) - -open Lwt.Infix - -let devnull = Lwt_main.run (Lwt_unix.openfile "/dev/null" [O_WRONLY] 0) - -(* A signal setup with both soft and hard exits to test both behaviours *) -let signal_setup = - Lwt_exit.make_signal_setup ~soft:[Sys.sigint; Sys.sigterm] ~hard:[Sys.sigusr1] - -let child_inted p = - Lwt_unix.dup2 devnull Lwt_unix.stderr ; - let r = ref 0 in - let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - incr r ; Lwt.return ()) - in - match Lwt_main.run @@ Lwt_exit.wrap_and_error p with - | Error 127 -> - assert (!r = 1) ; - Stdlib.exit 0 - | Error _ -> - assert false - | Ok _ -> - assert false - -let child_ok p = - Lwt_unix.dup2 devnull Lwt_unix.stderr ; - let r = ref 0 in - let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - incr r ; Lwt.return ()) - in - match Lwt_main.run @@ Lwt_exit.wrap_and_error p with - | Ok 1024 -> - assert (!r = 0) ; - Stdlib.exit 0 - | Ok _ -> - assert false - | Error _ -> - assert false - -let child_already_cleaned p = - Lwt_unix.dup2 devnull Lwt_unix.stderr ; - let r = ref 0 in - let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - incr r ; Lwt.return ()) - in - match Lwt_main.run @@ Lwt_exit.wrap_and_error p with - | Error 2048 -> - Stdlib.exit 0 - | Error _ -> - assert false - | Ok _ -> - assert false - -let main pid = - let s : unit Lwt.t = - Lwt_unix.sleep 0.01 >>= fun () -> Unix.kill pid Sys.sigint ; Lwt.return () - in - Lwt_unix.waitpid [] pid - >|= fun (_, status) -> - Lwt.cancel s ; - match status with - | WEXITED 0 -> - () - | WEXITED _ -> - assert false - | WSIGNALED _ -> - assert false - | WSTOPPED _ -> - assert false - -let test_simple () = - match Lwt_unix.fork () with - | 0 -> - child_inted Lwt_exit.clean_up_starts - | pid -> - Lwt_main.run @@ main pid - -let test_map () = - match Lwt_unix.fork () with - | 0 -> - child_inted (Lwt_exit.clean_up_starts >|= function 127 -> 0 | _ -> 1) - | pid -> - Lwt_main.run @@ main pid - -let test_bind () = - match Lwt_unix.fork () with - | 0 -> - child_inted - ( Lwt_exit.clean_up_starts - >>= function 127 -> Lwt.return 0 | _ -> Lwt.return 1 ) - | pid -> - Lwt_main.run @@ main pid - -let test_pick () = - match Lwt_unix.fork () with - | 0 -> - let dummy_state = ref 1024 in - let dummy_ev_wait () = - Lwt_unix.sleep 0.001 >|= fun () -> !dummy_state + 7 - in - let dummy_ev_handling ev = dummy_state := !dummy_state + (ev / 9) in - let rec dummy_loop () = - Lwt.pick - [ (Lwt_exit.clean_up_starts >|= fun _ -> 0); - ( dummy_ev_wait () - >>= fun ev -> dummy_ev_handling ev ; dummy_loop () ) ] - in - child_inted (dummy_loop ()) - | pid -> - Lwt_main.run @@ main pid - -let test_resolve_wait_by_clean_up () = - match Lwt_unix.fork () with - | 0 -> - let (p, r) = Lwt.wait () in - let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - Lwt.wakeup r 2000 ; Lwt.return_unit) - in - child_inted p - | pid -> - Lwt_main.run @@ main pid - -let test_resolve_task_by_clean_up () = - match Lwt_unix.fork () with - | 0 -> - let (p, r) = Lwt.task () in - let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - Lwt.wakeup r 2000 ; Lwt.return_unit) - in - child_inted p - | pid -> - Lwt_main.run @@ main pid - -let test_already_resolved () = - match Lwt_unix.fork () with - | 0 -> - child_ok (Lwt.return 1024) - | pid -> - Lwt_main.run @@ main pid - -let () = - test_simple () ; - test_map () ; - test_bind () ; - test_pick () ; - test_resolve_wait_by_clean_up () ; - test_resolve_task_by_clean_up () ; - test_already_resolved () ; - Stdlib.exit 0 diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_raise.ml b/src/lib_stdlib_unix/test/test_lwt_exit_raise.ml deleted file mode 100644 index 01c03cce8e97..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_raise.ml +++ /dev/null @@ -1,44 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -let devnull = Lwt_main.run (Lwt_unix.openfile "/dev/null" [O_WRONLY] 0) - -let () = Lwt_unix.dup2 devnull Lwt_unix.stderr - -let () = - match - Lwt_main.run - @@ Lwt_exit.wrap_and_error - ( Lwt.pause () - >>= fun () -> - raise Not_found >>= fun () -> Tezos_stdlib.Lwt_utils.never_ending () - ) - with - | Error 126 -> - () - | Error _ | Ok () -> - assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_raise_exit.ml b/src/lib_stdlib_unix/test/test_lwt_exit_raise_exit.ml deleted file mode 100644 index 090e433d5c56..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_raise_exit.ml +++ /dev/null @@ -1,43 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -let devnull = Lwt_main.run (Lwt_unix.openfile "/dev/null" [O_WRONLY] 0) - -let () = Lwt_unix.dup2 devnull Lwt_unix.stderr - -let () = - match - Lwt_main.run - @@ Lwt_exit.wrap_and_error - ( Lwt.pause () - >>= fun () -> - raise Exit >>= fun () -> Tezos_stdlib.Lwt_utils.never_ending () ) - with - | Error 126 -> - () - | Error _ | Ok () -> - assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_range_of_signals.ml b/src/lib_stdlib_unix/test/test_lwt_exit_range_of_signals.ml deleted file mode 100644 index 1dcfdf356834..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_range_of_signals.ml +++ /dev/null @@ -1,108 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(* The aim of this test is to check that Lwt_Exit can handle all the signals - that POSIX say are handleable. *) - -open Lwt.Infix - -let devnull = Lwt_main.run (Lwt_unix.openfile "/dev/null" [O_WRONLY] 0) - -let single_signal_setup signal = - Lwt_exit.make_signal_setup ~soft:[] ~hard:[signal] - -let rec child_loop () = Lwt_unix.sleep 0.1 >>= child_loop - -let child signal = - (* redirecting stderr to devnull to avoid polluting stderr with messages when - the child process is killed. These messages make the test look like it is - failing because they, obviously, look error-like. *) - Lwt_unix.dup2 devnull Lwt_unix.stderr ; - let signal_setup = single_signal_setup signal in - Stdlib.exit @@ Lwt_main.run - @@ Lwt_exit.wrap_and_exit ~signal_setup - @@ child_loop () - -let test_one_signal (signal, name) = - (* tests that a process that sets up a hard-handler for [signal] exits as - expected when receiving a signal. *) - match Lwt_unix.fork () with - | 0 -> - child signal - | pid -> ( - Lwt_main.run - @@ - let (_ : unit Lwt.t) = - Lwt_unix.sleep 0.01 >>= fun () -> Unix.kill pid signal ; Lwt.return () - in - Lwt_unix.waitpid [] pid - >|= fun (_, status) -> - match status with - | WEXITED s when s = 128 lor 127 -> - () - | WEXITED s -> - Format.kasprintf failwith "WEXITED(%d) on %s" s name - | WSIGNALED s -> - Format.kasprintf failwith "WSIGNALED(%d) on %s" s name - | WSTOPPED s -> - Format.kasprintf failwith "WSTOPPED(%d) on %s" s name ) - -let main () = - let open Sys in - List.iter - test_one_signal - [ (sigalrm, "ALRM"); - (sigchld, "CHLD"); - (sigabrt, "ABRT"); - (sigfpe, "FPE"); - (sighup, "HUP"); - (sigill, "ILL"); - (sigint, "INT"); - (sigpipe, "PIPE"); - (sigquit, "QUIT"); - (sigsegv, "SEGV"); - (sigterm, "TERM"); - (sigusr1, "USR1"); - (sigusr2, "USR2"); - (sigcont, "CONT"); - (sigtstp, "TSTP"); - (sigttin, "TTIN"); - (sigttou, "TTOU"); - (sigvtalrm, "VTALRM"); - (sigprof, "PROF"); - (sigbus, "BUS"); - (sigpoll, "POLL"); - (sigsys, "SYS"); - (sigtrap, "TRAP"); - (sigurg, "URG"); - (sigxcpu, "XCPU"); - (sigxfsz, "XFSZ") ] - -(** Non-catchable signals - (sigkill, "KILL"); - (sigstop, "STOP"); - *) - -let () = main () diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_return.ml b/src/lib_stdlib_unix/test/test_lwt_exit_return.ml deleted file mode 100644 index 7077d655edea..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_return.ml +++ /dev/null @@ -1,36 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -let () = - match - Lwt_main.run - @@ Lwt_exit.wrap_and_error (Lwt.pause () >>= fun () -> Lwt.return ()) - with - | Ok () -> - () - | Error _ -> - assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_signal.ml b/src/lib_stdlib_unix/test/test_lwt_exit_signal.ml deleted file mode 100644 index 65f8a82b9dd1..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_signal.ml +++ /dev/null @@ -1,235 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -let devnull = Lwt_main.run (Lwt_unix.openfile "/dev/null" [O_WRONLY] 0) - -(* A signal setup with both soft and hard exits to test both behaviours *) -let signal_setup = - Lwt_exit.make_signal_setup ~soft:[Sys.sigint; Sys.sigterm] ~hard:[Sys.sigusr1] - -let default_double_signal_safety = Option.get @@ Ptime.Span.of_float_s 0.1 - -let short_max_clean_up_time = Option.get @@ Ptime.Span.of_float_s 0.04 - -let child_main ?double_signal_safety ?max_clean_up_time () = - let double_signal_safety = - Option.value double_signal_safety ~default:default_double_signal_safety - in - Lwt_unix.dup2 devnull Lwt_unix.stderr ; - let r = ref 10 in - let _ = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - Lwt_unix.sleep 0.02 - >>= fun () -> - r := 11 ; - Lwt_unix.sleep 0.05 - >>= fun () -> - r := 12 ; - Lwt_unix.sleep 0.2 >>= fun () -> Lwt.return ()) - in - Stdlib.exit @@ Lwt_main.run - @@ ( Lwt_exit.wrap_and_error - ?max_clean_up_time - ~double_signal_safety - ~signal_setup - (Tezos_stdlib.Lwt_utils.never_ending ()) - >>= function - | Ok () -> - Lwt.return 3 - | Error code -> - if code = 127 then Lwt.return !r - else if code = 127 lor 128 then Lwt.return (!r lor 128) - else Lwt.return code ) - -let main () = - (* test INT *) - match Lwt_unix.fork () with - | 0 -> - child_main () - | pid -> ( - Lwt_main.run - (let s : unit Lwt.t = - Lwt_unix.sleep 0.01 - >>= fun () -> Unix.kill pid Sys.sigint ; Lwt.return () - in - Lwt_unix.waitpid [] pid - >|= fun (_, status) -> - Lwt.cancel s ; - match status with - | WEXITED 12 -> - () - | WEXITED _ -> - assert false - | WSIGNALED _ -> - assert false - | WSTOPPED _ -> - assert false) ; - (* test INT short clean-up time *) - match Lwt_unix.fork () with - | 0 -> - child_main ~max_clean_up_time:short_max_clean_up_time () - | pid -> ( - Lwt_main.run - (let s : unit Lwt.t = - Lwt_unix.sleep 0.01 - >>= fun () -> Unix.kill pid Sys.sigint ; Lwt.return () - in - Lwt_unix.waitpid [] pid - >|= fun (_, status) -> - Lwt.cancel s ; - match status with - | WEXITED s when s = 128 lor 11 -> - () - | WEXITED _ -> - assert false - | WSIGNALED _ -> - assert false - | WSTOPPED _ -> - assert false) ; - (* test INT-short-sleep-INT *) - match Lwt_unix.fork () with - | 0 -> - child_main () - | pid -> ( - Lwt_main.run - (let s : unit Lwt.t = - Lwt_unix.sleep 0.01 - >>= fun () -> - Unix.kill pid Sys.sigint ; - Lwt_unix.sleep 0.02 - >>= fun () -> Unix.kill pid Sys.sigint ; Lwt.return () - in - Lwt_unix.waitpid [] pid - >|= fun (_, status) -> - Lwt.cancel s ; - match status with - | WEXITED 12 -> - () - | WEXITED _ -> - assert false - | WSIGNALED _ -> - assert false - | WSTOPPED _ -> - assert false) ; - (* test INT-long-sleep-INT *) - match Lwt_unix.fork () with - | 0 -> - child_main () - | pid -> ( - Lwt_main.run - (let s : unit Lwt.t = - Lwt_unix.sleep 0.01 - >>= fun () -> - Unix.kill pid Sys.sigint ; - Lwt_unix.sleep 0.11 - >>= fun () -> Unix.kill pid Sys.sigint ; Lwt.return () - in - Lwt_unix.waitpid [] pid - >|= fun (_, status) -> - Lwt.cancel s ; - match status with - | WEXITED s when s = 127 lor 128 -> - () - | WEXITED _ -> - assert false - | WSIGNALED _ -> - assert false - | WSTOPPED _ -> - assert false) ; - (* test no double-signal safety *) - match Lwt_unix.fork () with - | 0 -> - child_main ~double_signal_safety:Ptime.Span.zero () - | pid -> ( - Lwt_main.run - (let s : unit Lwt.t = - Lwt_unix.sleep 0.01 - >>= fun () -> - Unix.kill pid Sys.sigint ; - Lwt_unix.sleep 0.02 - >>= fun () -> - Unix.kill pid Sys.sigint ; Lwt.return_unit - in - Lwt_unix.waitpid [] pid - >|= fun (_, status) -> - Lwt.cancel s ; - match status with - | WEXITED s when s = 127 lor 128 -> - () - | WEXITED _ -> - assert false - | WSIGNALED _ -> - assert false - | WSTOPPED _ -> - assert false) ; - (* test USR1 (hard) *) - match Lwt_unix.fork () with - | 0 -> - child_main () - | pid -> ( - Lwt_main.run - (let s : unit Lwt.t = - Lwt_unix.sleep 0.01 - >>= fun () -> - Unix.kill pid Sys.sigusr1 ; Lwt.return () - in - Lwt_unix.waitpid [] pid - >|= fun (_, status) -> - Lwt.cancel s ; - match status with - | WEXITED s when s = 127 lor 128 -> - () - | WEXITED _ -> - assert false - | WSIGNALED _ -> - assert false - | WSTOPPED _ -> - assert false) ; - (* test KILL *) - match Lwt_unix.fork () with - | 0 -> - child_main () - | pid -> - Lwt_main.run - (let s : unit Lwt.t = - Lwt_unix.sleep 0.01 - >>= fun () -> - Unix.kill pid Sys.sigkill ; Lwt.return () - in - Lwt_unix.waitpid [] pid - >|= fun (_, status) -> - Lwt.cancel s ; - match status with - | WEXITED _ -> - assert false - | WSIGNALED _ -> - () - | WSTOPPED _ -> - assert false) ; - () ) ) ) ) ) ) - -let () = main () ; Stdlib.exit 0 diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up.ml b/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up.ml deleted file mode 100644 index e8cd245ce930..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up.ml +++ /dev/null @@ -1,51 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -let r = ref 0 - -let clean_up_callback_id = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun s -> - Lwt_unix.sleep 0.01 - >>= fun () -> - r := s ; - Lwt.return_unit) - -let () = - match - Lwt_main.run - @@ Lwt_exit.wrap_and_error - ( Lwt_unix.sleep 0.01 - >>= fun () -> - Lwt_exit.unregister_clean_up_callback clean_up_callback_id ; - Lwt_unix.sleep 0.01 >>= fun () -> Lwt_exit.exit_and_raise 10 ) - with - | Error 10 -> - assert (!r = 0) - | Error _ -> - assert false - | Ok _ -> - assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up_with_after.ml b/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up_with_after.ml deleted file mode 100644 index 468bf1bdfc6e..000000000000 --- a/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up_with_after.ml +++ /dev/null @@ -1,61 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Lwt.Infix - -let r = ref 2 - -let clean_up_callback_id = - Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - Lwt_unix.sleep 0.01 - >>= fun () -> - r := !r * 3 ; - Lwt.return_unit) - -let _ = - Lwt_exit.register_clean_up_callback - ~loc:__LOC__ - ~after:[clean_up_callback_id] - (fun _ -> - Lwt_unix.sleep 0.01 - >>= fun () -> - r := !r * 5 ; - Lwt.return_unit) - -let () = - match - Lwt_main.run - @@ Lwt_exit.wrap_and_error - ( Lwt_unix.sleep 0.01 - >>= fun () -> - Lwt_exit.unregister_clean_up_callback clean_up_callback_id ; - Lwt_unix.sleep 0.01 >>= fun () -> Lwt_exit.exit_and_raise 10 ) - with - | Error 10 -> - assert (!r = 10) - | Error _ -> - assert false - | Ok _ -> - assert false diff --git a/src/proto_007_PsDELPH1/lib_delegate/dune b/src/proto_007_PsDELPH1/lib_delegate/dune index c6079ae60850..0aef819b7242 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/dune +++ b/src/proto_007_PsDELPH1/lib_delegate/dune @@ -14,7 +14,8 @@ tezos-storage tezos-rpc-http tezos-rpc - lwt-canceler) + lwt-canceler + lwt-exit) (library_flags (:standard -linkall)) (modules (:standard \ delegate_commands diff --git a/src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1.opam b/src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1.opam index 4d3214dcff44..240f006a0182 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1.opam +++ b/src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1.opam @@ -18,6 +18,7 @@ depends: [ "tezos-client-commands" "tezos-client-007-PsDELPH1" "lwt-canceler" { = "0.2" } + "lwt-exit" ] build: [ ["dune" "build" "-p" name "-j" jobs] diff --git a/src/proto_008_PtEdoTez/lib_delegate/dune b/src/proto_008_PtEdoTez/lib_delegate/dune index d8a8517f93e4..9aec126aa0ec 100644 --- a/src/proto_008_PtEdoTez/lib_delegate/dune +++ b/src/proto_008_PtEdoTez/lib_delegate/dune @@ -14,7 +14,8 @@ tezos-storage tezos-rpc-http tezos-rpc - lwt-canceler) + lwt-canceler + lwt-exit) (library_flags (:standard -linkall)) (modules (:standard \ delegate_commands diff --git a/src/proto_008_PtEdoTez/lib_delegate/tezos-baking-008-PtEdoTez.opam b/src/proto_008_PtEdoTez/lib_delegate/tezos-baking-008-PtEdoTez.opam index 67e51fc854ce..38e612479a9f 100644 --- a/src/proto_008_PtEdoTez/lib_delegate/tezos-baking-008-PtEdoTez.opam +++ b/src/proto_008_PtEdoTez/lib_delegate/tezos-baking-008-PtEdoTez.opam @@ -18,6 +18,7 @@ depends: [ "tezos-client-commands" "tezos-client-008-PtEdoTez" "lwt-canceler" { = "0.2" } + "lwt-exit" ] build: [ ["dune" "build" "-p" name "-j" jobs] diff --git a/src/proto_alpha/lib_delegate/dune b/src/proto_alpha/lib_delegate/dune index 24fdbfc905b9..c01d38fb22dd 100644 --- a/src/proto_alpha/lib_delegate/dune +++ b/src/proto_alpha/lib_delegate/dune @@ -14,7 +14,8 @@ tezos-storage tezos-rpc-http tezos-rpc - lwt-canceler) + lwt-canceler + lwt-exit) (library_flags (:standard -linkall)) (modules (:standard \ delegate_commands diff --git a/src/proto_alpha/lib_delegate/tezos-baking-alpha.opam b/src/proto_alpha/lib_delegate/tezos-baking-alpha.opam index 2cf6c3e6104b..abd848c8fad5 100644 --- a/src/proto_alpha/lib_delegate/tezos-baking-alpha.opam +++ b/src/proto_alpha/lib_delegate/tezos-baking-alpha.opam @@ -18,6 +18,7 @@ depends: [ "tezos-client-commands" "tezos-client-alpha" "lwt-canceler" { = "0.2" } + "lwt-exit" ] build: [ ["dune" "build" "-p" name "-j" jobs] -- GitLab From 8a513cc6d90590a4832621ac3c27181f821c2bd6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 8 Dec 2020 10:30:54 +0100 Subject: [PATCH 2/2] TEMPORARY: CI: point to NL opam repo --- .gitlab-ci.yml | 2 +- scripts/version.sh | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 076148186a1f..68ffec8e29c1 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -16,7 +16,7 @@ include: variables: ## Please update `scripts/version.sh` accordingly build_deps_image_version: 8312444f0f524f5456cdf3660328b6bbffd0107c - build_deps_image_name: registry.gitlab.com/tezos/opam-repository + build_deps_image_name: registry.gitlab.com/nomadic-labs/opam-repository public_docker_image_name: docker.io/${CI_PROJECT_PATH} GIT_STRATEGY: fetch GIT_DEPTH: "1" diff --git a/scripts/version.sh b/scripts/version.sh index 4f9177a3cf49..d6723e7fab48 100755 --- a/scripts/version.sh +++ b/scripts/version.sh @@ -14,7 +14,7 @@ full_opam_repository_tag=bf94421703ae6d95113e5b24890f304701e47b78 ## opam_repository is an additional, tezos-specific opam repository. opam_repository_tag=8312444f0f524f5456cdf3660328b6bbffd0107c -opam_repository_url=https://gitlab.com/tezos/opam-repository.git +opam_repository_url=https://gitlab.com/nomadic-labs/opam-repository.git opam_repository=$opam_repository_url\#$opam_repository_tag ## Other variables, used both in Makefile and scripts -- GitLab