From 2c50e3c3d8cced63e54d820be321f6bae6efb232 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 25 May 2021 09:56:28 +0200 Subject: [PATCH 1/4] Lwtreslib: fuzz test Option against List Options are just 0-/1-lengthed lists! --- src/lib_lwt_result_stdlib/test/dune | 56 +----------- .../test/test_fuzzing_helpers.ml | 2 + .../test/test_fuzzing_option.ml | 90 +++++++++++++++++++ 3 files changed, 95 insertions(+), 53 deletions(-) create mode 100644 src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml diff --git a/src/lib_lwt_result_stdlib/test/dune b/src/lib_lwt_result_stdlib/test/dune index b1c6ce8cd863..03fe8c84542b 100644 --- a/src/lib_lwt_result_stdlib/test/dune +++ b/src/lib_lwt_result_stdlib/test/dune @@ -1,4 +1,4 @@ -(executables +(tests (names test_hashtbl test_list_basic @@ -8,6 +8,7 @@ test_fuzzing_list test_fuzzing_set test_fuzzing_seq_tiered + test_fuzzing_option ) (libraries tezos-lwt-result-stdlib @@ -16,57 +17,6 @@ alcotest-lwt qcheck-alcotest lib-test) - (flags (:standard -open Tezos_lwt_result_stdlib))) - -(alias - (name buildtest) - (deps - test_hashtbl.exe - test_generic.exe - test_list_basic.exe - test_seq_basic.exe - test_fuzzing_seq.exe - test_fuzzing_list.exe - test_fuzzing_set.exe - )) - -(rule - (alias runtest_hashtbl) - (action (run %{exe:test_hashtbl.exe}))) -(rule - (alias runtest_generic) - (action (run %{exe:test_generic.exe}))) -(rule - (alias runtest_list_basic) - (action (run %{exe:test_list_basic.exe}))) -(rule - (alias runtest_seq_basic) - (action (run %{exe:test_seq_basic.exe}))) -(rule - (alias runtest_fuzzing_seq) - (action (run %{exe:test_fuzzing_seq.exe}))) -(rule - (alias runtest_fuzzing_list) - (action (run %{exe:test_fuzzing_list.exe}))) -(rule - (alias runtest_fuzzing_set) - (action (run %{exe:test_fuzzing_set.exe}))) -(rule - (alias runtest_fuzzing_seq_tiered) - (action (run %{exe:test_fuzzing_seq_tiered.exe}))) - -(rule - (alias runtest) + (flags (:standard -open Tezos_lwt_result_stdlib)) (package tezos-lwt-result-stdlib) - (deps - (alias runtest_hashtbl) - (alias runtest_generic) - (alias runtest_list_basic) - (alias runtest_seq_basic) - (alias runtest_fuzzing_seq) - (alias runtest_fuzzing_list) - (alias runtest_fuzzing_set) - (alias runtest_fuzzing_seq_tiered) - ) - (action (progn)) ) diff --git a/src/lib_lwt_result_stdlib/test/test_fuzzing_helpers.ml b/src/lib_lwt_result_stdlib/test/test_fuzzing_helpers.ml index f42d3c267121..d8f6606557b4 100644 --- a/src/lib_lwt_result_stdlib/test/test_fuzzing_helpers.ml +++ b/src/lib_lwt_result_stdlib/test/test_fuzzing_helpers.ml @@ -404,6 +404,8 @@ let one = QCheck.int let many = QCheck.(list int) +let maybe = QCheck.(option int) + let manymany = let open QCheck in oneof diff --git a/src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml b/src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml new file mode 100644 index 000000000000..8a0f792b2479 --- /dev/null +++ b/src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml @@ -0,0 +1,90 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 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 Support.Lib +open Test_fuzzing_helpers + +(* First series of tests: testing equivalence with size-1 lists *) +module TestIter = struct + open QCheck + open Monad + + let iter = + Test.make + ~name:"{Option,List([01])}.iter" + (triple Test_fuzzing_helpers.Fn.arith one maybe) + (fun (Fun (_, fn), init, input) -> + eq + (let acc = ref init in + Option.iter (IterOf.fn acc fn) input ; + !acc) + (let acc = ref init in + List.iter (IterOf.fn acc fn) (Option.to_list input) ; + !acc)) + + let iter_e = + Test.make + ~name:"{Option,List([01])}.iter_e" + (triple Test_fuzzing_helpers.Fn.arith one maybe) + (fun (Fun (_, fn), init, input) -> + eq_e + (let acc = ref init in + Option.iter_e (IterEOf.fn acc fn) input >|? fun () -> !acc) + (let acc = ref init in + List.iter_e (IterEOf.fn acc fn) (Option.to_list input) + >|? fun () -> !acc)) + + let iter_s = + Test.make + ~name:"{Option,List([01])}.iter_s" + (triple Test_fuzzing_helpers.Fn.arith one maybe) + (fun (Fun (_, fn), init, input) -> + eq_s + (let acc = ref init in + Option.iter_s (IterSOf.fn acc fn) input >|= fun () -> !acc) + (let acc = ref init in + List.iter_s (IterSOf.fn acc fn) (Option.to_list input) + >|= fun () -> !acc)) + + let iter_es = + Test.make + ~name:"{Option,List([01])}.iter_es" + (triple Test_fuzzing_helpers.Fn.arith one maybe) + (fun (Fun (_, fn), init, input) -> + eq_es + (let acc = ref init in + Option.iter_es (IterESOf.fn acc fn) input >|=? fun () -> !acc) + (let acc = ref init in + List.iter_es (IterESOf.fn acc fn) (Option.to_list input) + >|=? fun () -> !acc)) + + let tests = [iter; iter_e; iter_s; iter_es] +end + +let () = + let tests = + [("iter*", Lib_test.Qcheck_helpers.qcheck_wrap TestIter.tests)] + in + Alcotest.run "Option" tests -- GitLab From 422c7307bd2a667238104cb4ee291ca79d3a28b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 25 May 2021 10:09:27 +0200 Subject: [PATCH 2/4] Lwtreslib: Option.filter* --- src/lib_lwt_result_stdlib/bare/sigs/option.ml | 47 +++++++ .../bare/structs/option.ml | 43 ++++++ .../test/test_fuzzing_option.ml | 126 +++++++++++++++++- 3 files changed, 215 insertions(+), 1 deletion(-) diff --git a/src/lib_lwt_result_stdlib/bare/sigs/option.ml b/src/lib_lwt_result_stdlib/bare/sigs/option.ml index 29de6b6f52f5..929a0d8774ab 100644 --- a/src/lib_lwt_result_stdlib/bare/sigs/option.ml +++ b/src/lib_lwt_result_stdlib/bare/sigs/option.ml @@ -117,6 +117,53 @@ module type S = sig val fold_f : none:(unit -> 'a) -> some:('b -> 'a) -> 'b option -> 'a + (** [filter p o] is [Some x] iff [o] is [Some x] and [p o] is [true]. + + In other words, [filter] is like [List.filter] if [option] is the type of + lists of either zero or one elements. In fact, the following equality + holds for all [p] and for all [o]: + [Option.filter p o = List.hd (List.filter p (Option.to_list o))] + + The other [filter] variants below are also equivalent to their [List] + counterpart and a similar equality holds. *) + val filter : ('a -> bool) -> 'a option -> 'a option + + (** [filter_map] is the [Option] counterpart to [List]'s [filter_map]. + Incidentally, [filter_map f o] is also [bind o f]. *) + val filter_map : ('a -> 'b option) -> 'a option -> 'b option + + (** [filter_s] is [filter] where the predicate returns a promise. *) + val filter_s : ('a -> bool Lwt.t) -> 'a option -> 'a option Lwt.t + + (** [filter_map_s] is [filter_map] where the function returns a promise. *) + val filter_map_s : ('a -> 'b option Lwt.t) -> 'a option -> 'b option Lwt.t + + (** [filter_e] is [filter] where the predicate returns a [result]. *) + val filter_e : + ('a -> (bool, 'e) result) -> 'a option -> ('a option, 'e) result + + (** [filter_map_e] is [filter_map] where the function returns a [result]. *) + val filter_map_e : + ('a -> ('b option, 'e) result) -> 'a option -> ('b option, 'e) result + + (** [filter_es] is [filter] where the predicate returns a promise of a [result]. *) + val filter_es : + ('a -> (bool, 'e) result Lwt.t) -> + 'a option -> + ('a option, 'e) result Lwt.t + + (** [filter_map_es] is [filter_map] where the function returns a promise of a [result]. *) + val filter_map_es : + ('a -> ('b option, 'e) result Lwt.t) -> + 'a option -> + ('b option, 'e) result Lwt.t + + (** [filter_ok o] is [Some x] iff [o] is [Some (Ok x)]. *) + val filter_ok : ('a, 'e) result option -> 'a option + + (** [filter_error o] is [Some x] iff [o] is [Some (Error x)]. *) + val filter_error : ('a, 'e) result option -> 'e option + val iter : ('a -> unit) -> 'a option -> unit val iter_s : ('a -> unit Lwt.t) -> 'a option -> unit Lwt.t diff --git a/src/lib_lwt_result_stdlib/bare/structs/option.ml b/src/lib_lwt_result_stdlib/bare/structs/option.ml index 9d2dc7ba67cc..52c82213755f 100644 --- a/src/lib_lwt_result_stdlib/bare/structs/option.ml +++ b/src/lib_lwt_result_stdlib/bare/structs/option.ml @@ -92,6 +92,49 @@ let fold_s ~none ~some = function None -> Lwt.return none | Some v -> some v let fold_f ~none ~some = function None -> none () | Some v -> some v +let filter p o = match o with Some x when p x -> o | Some _ | None -> None + +let filter_s p o = + match o with + | None -> + none_s + | Some x -> ( + p x >>= function true -> Lwt.return o | false -> none_s ) + +let filter_e p o = + match o with + | None -> + none_e + | Some x -> ( + p x >>? function true -> Ok o | false -> none_e ) + +let filter_es p o = + match o with + | None -> + none_es + | Some x -> ( + p x >>=? function true -> Monad.return o | false -> none_es ) + +let filter_map f o = bind o f + +let filter_map_s f o = match o with None -> none_s | Some x -> f x + +let filter_map_e f o = match o with None -> none_e | Some x -> f x + +let filter_map_es f o = match o with None -> none_es | Some x -> f x + +let filter_ok = function + | Some (Ok x) -> + Some x + | Some (Error _) | None -> + None + +let filter_error = function + | Some (Error x) -> + Some x + | Some (Ok _) | None -> + None + let iter_s f = function None -> Lwt.return_unit | Some v -> f v let iter_e f = function None -> Ok () | Some v -> f v diff --git a/src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml b/src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml index 8a0f792b2479..1a774c7006a3 100644 --- a/src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml +++ b/src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml @@ -27,6 +27,8 @@ open Support.Lib open Test_fuzzing_helpers (* First series of tests: testing equivalence with size-1 lists *) + +(* First-1: testing equivalence of iter* *) module TestIter = struct open QCheck open Monad @@ -83,8 +85,130 @@ module TestIter = struct let tests = [iter; iter_e; iter_s; iter_es] end +(* First-2: testing equivalence of filter* *) +module TestFilter = struct + open QCheck + open Monad + + let filter = + Test.make + ~name:"{Option,List([01])}.filter" + (triple Test_fuzzing_helpers.Fn.pred one maybe) + (fun (fn, const, input) -> + eq + (Option.filter (CondOf.fn fn const) input) + (List.filter (CondOf.fn fn const) (Option.to_list input) |> List.hd)) + + let filter_e = + Test.make + ~name:"{Option,List([01])}.filter_e" + (triple Test_fuzzing_helpers.Fn.pred one maybe) + (fun (fn, const, input) -> + eq_e + (Option.filter_e (CondEOf.fn fn const) input) + ( List.filter_e (CondEOf.fn fn const) (Option.to_list input) + >|? List.hd )) + + let filter_s = + Test.make + ~name:"{Option,List([01])}.filter_s" + (triple Test_fuzzing_helpers.Fn.pred one maybe) + (fun (fn, const, input) -> + eq_s + (Option.filter_s (CondSOf.fn fn const) input) + ( List.filter_s (CondSOf.fn fn const) (Option.to_list input) + >|= List.hd )) + + let filter_es = + Test.make + ~name:"{Option,List([01])}.filter_es" + (triple Test_fuzzing_helpers.Fn.pred one maybe) + (fun (fn, const, input) -> + eq_es + (Option.filter_es (CondESOf.fn fn const) input) + ( List.filter_es (CondESOf.fn fn const) (Option.to_list input) + >|=? List.hd )) + + let tests = [filter; filter_e; filter_s; filter_es] +end + +(* First-3: testing equivalence of filter_map* *) +module TestFilterMap = struct + open QCheck + open Monad + + let filter_map = + Test.make + ~name:"{Option,List([01])}.filter_map" + (quad + Test_fuzzing_helpers.Fn.pred + Test_fuzzing_helpers.Fn.arith + one + maybe) + (fun (pred, Fun (_, arith), const, input) -> + eq + (Option.filter_map (FilterMapOf.fns pred arith const) input) + ( List.filter_map + (FilterMapOf.fns pred arith const) + (Option.to_list input) + |> List.hd )) + + let filter_map_e = + Test.make + ~name:"{Option,List([01])}.filter_map_e" + (quad + Test_fuzzing_helpers.Fn.pred + Test_fuzzing_helpers.Fn.arith + one + maybe) + (fun (pred, Fun (_, arith), const, input) -> + eq_e + (Option.filter_map_e (FilterMapEOf.fns pred arith const) input) + ( List.filter_map_e + (FilterMapEOf.fns pred arith const) + (Option.to_list input) + >|? List.hd )) + + let filter_map_s = + Test.make + ~name:"{Option,List([01])}.filter_map_s" + (quad + Test_fuzzing_helpers.Fn.pred + Test_fuzzing_helpers.Fn.arith + one + maybe) + (fun (pred, Fun (_, arith), const, input) -> + eq_s + (Option.filter_map_s (FilterMapSOf.fns pred arith const) input) + ( List.filter_map_s + (FilterMapSOf.fns pred arith const) + (Option.to_list input) + >|= List.hd )) + + let filter_map_es = + Test.make + ~name:"{Option,List([01])}.filter_map_es" + (quad + Test_fuzzing_helpers.Fn.pred + Test_fuzzing_helpers.Fn.arith + one + maybe) + (fun (pred, Fun (_, arith), const, input) -> + eq_es + (Option.filter_map_es (FilterMapESOf.fns pred arith const) input) + ( List.filter_map_es + (FilterMapESOf.fns pred arith const) + (Option.to_list input) + >|=? List.hd )) + + let tests = [filter_map; filter_map_e; filter_map_s; filter_map_es] +end + let () = let tests = - [("iter*", Lib_test.Qcheck_helpers.qcheck_wrap TestIter.tests)] + [ ("iter*", Lib_test.Qcheck_helpers.qcheck_wrap TestIter.tests); + ("filter*", Lib_test.Qcheck_helpers.qcheck_wrap TestFilter.tests); + ("filter_map*", Lib_test.Qcheck_helpers.qcheck_wrap TestFilterMap.tests) + ] in Alcotest.run "Option" tests -- GitLab From f5a6e6cf7b7dd99875d15e5f25dd7fca907ba2a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 25 May 2021 10:56:58 +0200 Subject: [PATCH 3/4] Node: minor refactoring --- src/bin_node/node_storage_command.ml | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/bin_node/node_storage_command.ml b/src/bin_node/node_storage_command.ml index 4470fb81033b..08ac8fa0c2a7 100644 --- a/src/bin_node/node_storage_command.ml +++ b/src/bin_node/node_storage_command.ml @@ -51,11 +51,9 @@ module Term = struct | Integrity_check_inodes let read_config_file config_file = - match config_file with - | Some config_file when Sys.file_exists config_file -> - Node_config_file.read config_file - | _ -> - return Node_config_file.default_config + Option.filter Sys.file_exists config_file + |> Option.map Node_config_file.read + |> Option.value ~default:(return Node_config_file.default_config) let ensure_context_dir context_dir = Lwt.catch -- GitLab From 686c6aa6e445ad71130996cbb2ec1e0c1676b543 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 25 May 2021 11:03:49 +0200 Subject: [PATCH 4/4] Lwtreslib: fuzz-test Option.map* --- .../test/test_fuzzing_option.ml | 49 ++++++++++++++++++- 1 file changed, 47 insertions(+), 2 deletions(-) diff --git a/src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml b/src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml index 1a774c7006a3..90d86a8bc747 100644 --- a/src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml +++ b/src/lib_lwt_result_stdlib/test/test_fuzzing_option.ml @@ -204,11 +204,56 @@ module TestFilterMap = struct let tests = [filter_map; filter_map_e; filter_map_s; filter_map_es] end +(* First-4: testing equivalence of map* *) +module TestMap = struct + open QCheck + open Monad + + let map = + Test.make + ~name:"{Option,List([01])}.map" + (triple Test_fuzzing_helpers.Fn.arith one maybe) + (fun (Fun (_, fn), const, input) -> + eq + (Option.map (MapOf.fn const fn) input) + (List.map (MapOf.fn const fn) (Option.to_list input) |> List.hd)) + + let map_e = + Test.make + ~name:"{Option,List([01])}.map_e" + (triple Test_fuzzing_helpers.Fn.arith one maybe) + (fun (Fun (_, fn), const, input) -> + eq + (Option.map_e (MapEOf.fn const fn) input) + (List.map_e (MapEOf.fn const fn) (Option.to_list input) >|? List.hd)) + + let map_s = + Test.make + ~name:"{Option,List([01])}.map_s" + (triple Test_fuzzing_helpers.Fn.arith one maybe) + (fun (Fun (_, fn), const, input) -> + eq + (Option.map_s (MapSOf.fn const fn) input) + (List.map_s (MapSOf.fn const fn) (Option.to_list input) >|= List.hd)) + + let map_es = + Test.make + ~name:"{Option,List([01])}.map_es" + (triple Test_fuzzing_helpers.Fn.arith one maybe) + (fun (Fun (_, fn), const, input) -> + eq + (Option.map_es (MapESOf.fn const fn) input) + ( List.map_es (MapESOf.fn const fn) (Option.to_list input) + >|=? List.hd )) + + let tests = [map; map_e; map_s; map_es] +end + let () = let tests = [ ("iter*", Lib_test.Qcheck_helpers.qcheck_wrap TestIter.tests); ("filter*", Lib_test.Qcheck_helpers.qcheck_wrap TestFilter.tests); - ("filter_map*", Lib_test.Qcheck_helpers.qcheck_wrap TestFilterMap.tests) - ] + ("filter_map*", Lib_test.Qcheck_helpers.qcheck_wrap TestFilterMap.tests); + ("map*", Lib_test.Qcheck_helpers.qcheck_wrap TestIter.tests) ] in Alcotest.run "Option" tests -- GitLab