From f7d6a5ea585dd56b2910cfdf020028cbffcba34c Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 19 Nov 2019 15:31:36 +0100 Subject: [PATCH] allow to catch failwith's in our tests --- src/main/run/of_michelson.ml | 34 +++++++++++++++++++ src/main/run/of_simplified.ml | 11 ++++++ src/test/test_helpers.ml | 6 ++++ .../proto-alpha-utils/x_error_monad.ml | 1 + .../proto-alpha-utils/x_memory_proto_alpha.ml | 26 ++++++++++++++ vendors/ligo-utils/simple-utils/trace.ml | 6 ++++ 6 files changed, 84 insertions(+) diff --git a/src/main/run/of_michelson.ml b/src/main/run/of_michelson.ml index 41e49c7f3..a0a2e5e11 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -35,6 +35,40 @@ let run ?options (* ?(is_input_value = false) *) (program:compiled_program) (inp Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in ok (Ex_typed_value (output_ty, output)) +type failwith_res = + | Failwith_int of int + | Failwith_string of string + | Failwith_bytes of bytes + +let get_exec_error_aux ?options (program:compiled_program) (input_michelson:Michelson.t) : Memory_proto_alpha.Protocol.Script_repr.expr result = + let Compiler.Program.{input;output;body} : compiled_program = program in + let (Ex_ty input_ty) = input in + let (Ex_ty output_ty) = output in + let%bind input = + Trace.trace_tzresult_lwt (simple_error "error parsing input") @@ + Memory_proto_alpha.parse_michelson_data input_michelson input_ty + in + let body = Michelson.strip_annots body in + let%bind descr = + Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ + Memory_proto_alpha.parse_michelson body + (Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in + let%bind err = + Trace.trace_tzresult_lwt (simple_error "unexpected error of execution") @@ + Memory_proto_alpha.failure_interpret ?options descr (Item(input, Empty)) in + match err with + | Memory_proto_alpha.Succeed _ -> simple_fail "an error of execution was expected" + | Memory_proto_alpha.Fail expr -> + ok expr + +let get_exec_error ?options (program:compiled_program) (input_michelson:Michelson.t) : failwith_res result = + let%bind expr = get_exec_error_aux ?options program input_michelson in + match Tezos_micheline.Micheline.root @@ Memory_proto_alpha.strings_of_prims expr with + | Int (_ , i) -> ok (Failwith_int (Z.to_int i)) + | String (_ , s) -> ok (Failwith_string s) + | Bytes (_,b) -> ok (Failwith_bytes b) + | _ -> simple_fail "Unknown failwith" + let evaluate ?options program = run ?options program Michelson.d_unit let ex_value_ty_to_michelson (v : ex_typed_value) : Michelson.t result = diff --git a/src/main/run/of_simplified.ml b/src/main/run/of_simplified.ml index aab84e240..63b52746e 100644 --- a/src/main/run/of_simplified.ml +++ b/src/main/run/of_simplified.ml @@ -23,6 +23,17 @@ let run_typed_program (* TODO: this runs an *untyped* program, not a t let%bind ex_ty_value = Of_michelson.run ?options code input in Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry ex_ty_value +let run_failwith_program + ?options ?input_to_value + (program : Ast_typed.program) (state : Typer.Solver.state) (entry : string) + (input : expression) : Of_michelson.failwith_res result = + let%bind code = Compile.Of_typed.compile_function_entry program entry in + let%bind input = + let env = Ast_typed.program_environment program in + compile_expression ?value:input_to_value ~env ~state input + in + Of_michelson.get_exec_error ?options code input + let evaluate_typed_program_entry ?options (program : Ast_typed.program) (entry : string) diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index d7650a343..97e378688 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -51,6 +51,12 @@ let expect_fail ?options program entry_point input = Assert.assert_fail @@ Ligo.Run.Of_simplified.run_typed_program ?options program Typer.Solver.initial_state entry_point input +let expect_string_failwith ?options program entry_point input expected_failwith = + let%bind err = Ligo.Run.Of_simplified.run_failwith_program + ?options program Typer.Solver.initial_state entry_point input in + match err with + | Ligo.Run.Of_michelson.Failwith_string s -> Assert.assert_equal_string expected_failwith s + | _ -> simple_fail "Expected to fail with a string" let expect_eq ?input_to_value ?options program entry_point input expected = let expecter = fun result -> diff --git a/vendors/ligo-utils/proto-alpha-utils/x_error_monad.ml b/vendors/ligo-utils/proto-alpha-utils/x_error_monad.ml index aed5e1449..23213203a 100644 --- a/vendors/ligo-utils/proto-alpha-utils/x_error_monad.ml +++ b/vendors/ligo-utils/proto-alpha-utils/x_error_monad.ml @@ -5,6 +5,7 @@ open Memory_proto_alpha let (>>??) = Alpha_environment.Error_monad.(>>?) let alpha_wrap a = Alpha_environment.wrap_error a +let alpha_error_wrap x = Memory_proto_alpha.Alpha_environment.Ecoproto_error x let force_ok_alpha ~msg a = force_ok ~msg @@ alpha_wrap a diff --git a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml index 581ccbde4..d37bf59f7 100644 --- a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml +++ b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml @@ -1095,3 +1095,29 @@ let interpret ?(options = default_options) (instr:('a, 'b) descr) (bef:'a stack) let step_constants = { source ; self ; payer ; amount ; chain_id } in Script_interpreter.step tezos_context step_constants instr bef >>=?? fun (stack, _) -> return stack + +type 'a interpret_res = + | Succeed of 'a stack + | Fail of Script_repr.expr + +let failure_interpret + ?(options = default_options) + (instr:('a, 'b) descr) + (bef:'a stack) : 'b interpret_res tzresult Lwt.t = + let { + tezos_context ; + source ; + self ; + payer ; + amount ; + chain_id ; + } = options in + let step_constants = { source ; self ; payer ; amount ; chain_id } in + Script_interpreter.step tezos_context step_constants instr bef >>= fun x -> + match x with + | Ok (s , _ctxt) -> return @@ Succeed s + | Error ((Reject (_, expr, _))::_t) -> return @@ Fail expr (* This catches failwith errors *) + | Error errs -> Lwt.return @@ Error (List.map (alpha_error_wrap) errs) + + +let strings_of_prims = Michelson_v1_primitives.strings_of_prims \ No newline at end of file diff --git a/vendors/ligo-utils/simple-utils/trace.ml b/vendors/ligo-utils/simple-utils/trace.ml index 46981eae5..b15a05e1d 100644 --- a/vendors/ligo-utils/simple-utils/trace.ml +++ b/vendors/ligo-utils/simple-utils/trace.ml @@ -764,6 +764,12 @@ module Assert = struct let assert_equal ?msg expected actual = assert_true ?msg (expected = actual) + let assert_equal_string ?msg expected actual = + let msg = + let default = Format.asprintf "Not equal string : expected \"%s\", got \"%s\"" expected actual in + X_option.unopt ~default msg in + assert_equal ~msg expected actual + let assert_equal_int ?msg expected actual = let msg = let default = Format.asprintf "Not equal int : expected %d, got %d" expected actual in