package octez-protocol-alpha-libs
Octez protocol alpha libraries
Install
Dune Dependency
Authors
Maintainers
Sources
tezos-octez-v20.1.tag.bz2
sha256=ddfb5076eeb0b32ac21c1eed44e8fc86a6743ef18ab23fff02d36e365bb73d61
sha512=d22a827df5146e0aa274df48bc2150b098177ff7e5eab52c6109e867eb0a1f0ec63e6bfbb0e3645a6c2112de3877c91a17df32ccbff301891ce4ba630c997a65
doc/src/octez-protocol-alpha-libs.test-helpers/scenario_dsl.ml.html
Source file scenario_dsl.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205
(*****************************************************************************) (* *) (* SPDX-License-Identifier: MIT *) (* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com> *) (* *) (*****************************************************************************) open Log_helpers exception Test_failed (** A scenario is a succession of actions. We define a branching path as a way to create multiple tests from the same point. This allows easy compositionality of behaviors with minimal code sharing. The [Tag] allows to give meaningful identifiers to the branches. It is good practice to tag each case in a branch (it's not necessary, but since test names must be unique, at most one branch can remain unnamed, and even then it can create conflicting names.) *) type ('input, 'output) scenarios = | Action : ('input -> 'output tzresult Lwt.t) -> ('input, 'output) scenarios | Empty : ('t, 't) scenarios | Concat : (('a, 'b) scenarios * ('b, 'c) scenarios) -> ('a, 'c) scenarios | Branch : (('a, 'b) scenarios * ('a, 'b) scenarios) -> ('a, 'b) scenarios | Tag : (* Name for test branch *) string -> ('t, 't) scenarios | Slow : (* If in scenario branch, makes the test `Slow *) ('t, 't) scenarios (** Unfolded scenario type *) type ('input, 'output) single_scenario = | End_scenario : ('t, 't) single_scenario | Cons : (('input -> 't tzresult Lwt.t) * ('t, 'output) single_scenario) -> ('input, 'output) single_scenario let rec cat_ss : type a b c. (a, b) single_scenario -> (b, c) single_scenario -> (a, c) single_scenario = fun a b -> match a with End_scenario -> b | Cons (act, a') -> Cons (act, cat_ss a' b) let combine f l1 l2 = List.map (fun a -> List.map (fun b -> f a b) l2) l1 |> List.flatten let rec unfold_scenarios : type input output. (input, output) scenarios -> ((input, output) single_scenario * string list * bool) list = function | Slow -> [(End_scenario, [], true)] | Tag s -> [(End_scenario, [s], false)] | Empty -> [(End_scenario, [], false)] | Action a -> [(Cons (a, End_scenario), [], false)] | Branch (left, right) -> unfold_scenarios left @ unfold_scenarios right | Concat (left, right) -> let l = unfold_scenarios left in let r = unfold_scenarios right in combine (fun (sl, tl, bl) (sr, tr, br) -> (cat_ss sl sr, tl @ tr, bl || br)) l r let rec run_scenario : type input output. (input, output) single_scenario -> input -> output tzresult Lwt.t = let open Lwt_result_syntax in fun scenario input -> match scenario with | End_scenario -> return input | Cons (action, next) -> let* result = action input in run_scenario next result type test_closure = string * bool * (Tezt_tezos.Protocol.t -> unit Lwt.t) let unfolded_to_test : (unit, unit) single_scenario * string list * bool -> test_closure = let open Lwt_syntax in fun (s, title, is_slow) -> let title = match title with | [] -> "" | [n] -> n | header :: -> (* We chose to separate all tags with a comma, and use the head tag as a header for the test *) header ^ ": " ^ String.concat ", " tags in ( title, is_slow, fun _proto -> let* r = (run_scenario s) () in match r with | Ok () -> return_unit | Error e -> Log.error "%a@." Error_monad.pp_print_trace e ; raise Test_failed ) let register_test ~__FILE__ ~ ((title, is_slow, test) : test_closure) : unit = let = if is_slow then Tezos_test_helpers.Tag.slow :: tags else tags in Tezt_tezos.Protocol.( register_test ~__FILE__ ~title ~tags ~uses:(fun _ -> []) ~uses_node:false ~uses_client:false ~uses_admin_client:false test [Alpha]) let register_tests ~__FILE__ ~ (l : test_closure list) : unit = List.iter (register_test ~__FILE__ ~tags) l (** Useful aliases and operators *) (* Aliases for [Empty]. Can be used as first component of a scenario instead of a tag if its not needed. *) let noop = Empty let no_tag = Empty let concat : type a b c. (a, b) scenarios -> (b, c) scenarios -> (a, c) scenarios = fun a b -> match (a, b) with | Empty, Empty -> Empty | _, Empty -> a | Empty, _ -> b | _ -> Concat (a, b) let branch : type a b. (a, b) scenarios -> (a, b) scenarios -> (a, b) scenarios = fun a b -> match (a, b) with Empty, Empty -> Empty | _ -> Branch (a, b) (** Continuation connector: execute a then b *) let ( --> ) a b = concat a b (** Branching connector: creates two tests with different execution paths *) let ( |+ ) a b = branch a b (** Ends the test. Dump the state, returns [unit] *) let end_test : ('a, unit) scenarios = let open Lwt_result_syntax in Action (fun _ -> Log.info ~color:begin_end_color "-- End test --" ; return_unit) (** Transforms scenarios into tests *) let tests_of_scenarios : (string * (unit, 't) scenarios) list -> test_closure list = fun scenarios -> List.map (fun (s, x) -> Tag s --> x --> end_test) scenarios |> function | [] -> [] | a :: t -> List.fold_left ( |+ ) a t |> unfold_scenarios |> List.map unfolded_to_test (** Arbitrary execution *) let exec f = Action f (** Execute a function that does not modify the block, only the state *) let exec_state f = let open Lwt_result_syntax in Action (fun ((block, _state) as input) -> let* state = f input in return (block, state)) (** Execute a function that does not modify neither the block nor the state. Usually used for checks/asserts *) let exec_unit f = let open Lwt_result_syntax in Action (fun input -> let* () = f input in return input) (** [fold f l] folds [f] over [l], fails on empty list *) let rec fold : ('a -> ('b, 'c) scenarios) -> 'a list -> ('b, 'c) scenarios = fun f list -> match list with | [] -> Stdlib.failwith "Scenario_dsl.fold: empty list" | [x] -> f x | h :: t -> f h |+ fold f t (** [fold_tag f l] folds [f] over [l], [l] has a tag for each of its elements. Fails on empty list. *) let fold_tag : ('a -> ('b, 'c) scenarios) -> (string * 'a) list -> ('b, 'c) scenarios = fun f -> let f (s, x) = Tag s --> f x in fold f (** [fold_tag_f f tag l] folds [f] over [l], [tag] returns a tag for each element of [l]. Fails on empty list. *) let fold_tag_f : ('a -> ('b, 'c) scenarios) -> ('a -> string) -> 'a list -> ('b, 'c) scenarios = fun f tag -> let f x = Tag (tag x) --> f x in fold f (** [unfold f l] maps [f] over [l], and runs them in order *) let rec unfold : ('a -> ('b, 'b) scenarios) -> 'a list -> ('b, 'b) scenarios = fun f -> function [] -> Empty | [x] -> f x | h :: t -> f h --> unfold f t
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>