From 8ae83a12915b70dc6a06ec29d9f32da7e71d7cc1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 28 Nov 2023 16:34:00 +0100 Subject: [PATCH 1/3] Client/Michelson/Reporter: work on string parser_result s This commit adapts the error reporting mechanism to work at the level of string primitives so that it can be used with TZT. --- .../lib_client/client_proto_programs.ml | 3 +- .../lib_client/michelson_v1_emacs.ml | 4 +-- .../lib_client/michelson_v1_error_reporter.ml | 34 ++++++++++++++----- .../michelson_v1_error_reporter.mli | 4 +-- .../lib_client/michelson_v1_parser.ml | 6 ++++ .../lib_client/michelson_v1_parser.mli | 2 ++ .../lib_client/michelson_v1_printer.ml | 2 +- .../lib_client/michelson_v1_printer.mli | 3 +- .../client_proto_programs_commands.ml | 2 +- 9 files changed, 43 insertions(+), 17 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index 33105916b2af..f1026b2b5be1 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -54,6 +54,7 @@ end) let print_errors ?parsed (cctxt : #Protocol_client_context.full) errs ~show_source = let open Lwt_result_syntax in + let parsed = Option.map Michelson_v1_parser.unrecognize_prims parsed in let*! errs = Michelson_v1_error_reporter.enrich_runtime_errors cctxt @@ -491,7 +492,7 @@ let print_typecheck_result ~emacs ~show_types ~print_source_on_error (Michelson_v1_error_reporter.report_errors ~details:show_types ~show_source:print_source_on_error - ~parsed:program) + ~parsed:(Michelson_v1_parser.unrecognize_prims program)) errs in cctxt#error "script %S is ill-typed" name diff --git a/src/proto_alpha/lib_client/michelson_v1_emacs.ml b/src/proto_alpha/lib_client/michelson_v1_emacs.ml index 6de00de8b2f1..4de1ae254250 100644 --- a/src/proto_alpha/lib_client/michelson_v1_emacs.ml +++ b/src/proto_alpha/lib_client/michelson_v1_emacs.ml @@ -178,7 +178,7 @@ let report_errors ppf (parsed, errs) = (Michelson_v1_error_reporter.report_errors ~details:false ~show_source:false - ~parsed) + ~parsed:(Michelson_v1_parser.unrecognize_prims parsed)) errs in let {start = {point = s; _}; stop = {point = e; _}} = loc in @@ -222,7 +222,7 @@ let report_errors ppf (parsed, errs) = (Michelson_v1_error_reporter.report_errors ~details:false ~show_source:false - ~parsed) + ~parsed:(Michelson_v1_parser.unrecognize_prims parsed)) [err] in let {start = {point = s; _}; stop = {point = e; _}} = loc in diff --git a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml index 580e47209176..b13825d560ab 100644 --- a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml +++ b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml @@ -139,7 +139,8 @@ let fetch_script (cctxt : #Protocol_client_context.rpc_context) ~chain ~block Lwt.return @@ Environment.wrap_tzresult @@ Script_repr.force_decode code type error += - | Rich_runtime_contract_error of Contract_hash.t * Michelson_v1_parser.parsed + | Rich_runtime_contract_error of + Contract_hash.t * string Michelson_v1_parser.parser_result let enrich_runtime_errors cctxt ~chain ~block ~parsed = let open Lwt_result_syntax in @@ -155,12 +156,16 @@ let enrich_runtime_errors cctxt ~chain ~block ~parsed = @@ match script_opt with | Ok script -> - let parsed = Michelson_v1_printer.unparse_toplevel script in + let parsed = + Michelson_v1_parser.unrecognize_prims + @@ Michelson_v1_printer.unparse_toplevel script + in Rich_runtime_contract_error (contract, parsed) | Error err -> Fetch_script_meta_error err)) | e -> Lwt.return e) -let report_errors ~details ~show_source ?parsed ppf errs = +let report_errors ~details ~show_source + ?(parsed : string Michelson_v1_parser.parser_result option) ppf errs = let rec print_trace locations errs = let print_loc ppf loc = match locations loc with @@ -243,9 +248,13 @@ let report_errors ~details ~show_source ?parsed ppf errs = | Environment.Ecoproto_error (Ill_typed_data (name, expr, ty)) :: rest -> let parsed = match parsed with - | Some parsed when expr = parsed.Michelson_v1_parser.expanded -> + | Some parsed + when Michelson_v1_primitives.strings_of_prims expr + = parsed.Michelson_v1_parser.expanded -> parsed - | Some _ | None -> Michelson_v1_printer.unparse_expression expr + | Some _ | None -> + Michelson_v1_parser.unrecognize_prims + @@ Michelson_v1_printer.unparse_expression expr in let hilights = collect_error_locations rest in Format.fprintf @@ -312,9 +321,13 @@ let report_errors ~details ~show_source ?parsed ppf errs = | Environment.Ecoproto_error (Ill_formed_type (_, expr, loc)) :: rest -> let parsed = match parsed with - | Some parsed when expr = parsed.Michelson_v1_parser.expanded -> + | Some parsed + when Michelson_v1_primitives.strings_of_prims expr + = parsed.Michelson_v1_parser.expanded -> parsed - | Some _ | None -> Michelson_v1_printer.unparse_expression expr + | Some _ | None -> + Michelson_v1_parser.unrecognize_prims + @@ Michelson_v1_printer.unparse_expression expr in let hilights = loc :: collect_error_locations errs in if show_source then @@ -333,10 +346,13 @@ let report_errors ~details ~show_source ?parsed ppf errs = let parsed = match parsed with | Some parsed - when (not details) && expr = parsed.Michelson_v1_parser.expanded -> + when (not details) + && Michelson_v1_primitives.strings_of_prims expr + = parsed.Michelson_v1_parser.expanded -> parsed | Some _ | None -> - Michelson_v1_printer.unparse_toplevel ~type_map expr + Michelson_v1_parser.unrecognize_prims + @@ Michelson_v1_printer.unparse_toplevel ~type_map expr in let hilights = collect_error_locations rest in if show_source then diff --git a/src/proto_alpha/lib_client/michelson_v1_error_reporter.mli b/src/proto_alpha/lib_client/michelson_v1_error_reporter.mli index 1d3df5de4b1b..f221b25ca972 100644 --- a/src/proto_alpha/lib_client/michelson_v1_error_reporter.mli +++ b/src/proto_alpha/lib_client/michelson_v1_error_reporter.mli @@ -27,14 +27,14 @@ val enrich_runtime_errors : #Protocol_client_context.rpc_context -> chain:Shell_services.chain -> block:Shell_services.block -> - parsed:Michelson_v1_parser.parsed option -> + parsed:string Michelson_v1_parser.parser_result option -> Error_monad.error list -> Error_monad.error list Lwt.t val report_errors : details:bool -> show_source:bool -> - ?parsed:Michelson_v1_parser.parsed -> + ?parsed:string Michelson_v1_parser.parser_result -> Format.formatter -> Error_monad.error list -> unit diff --git a/src/proto_alpha/lib_client/michelson_v1_parser.ml b/src/proto_alpha/lib_client/michelson_v1_parser.ml index ed9b0fb4d6bf..4016dbcad9fe 100644 --- a/src/proto_alpha/lib_client/michelson_v1_parser.ml +++ b/src/proto_alpha/lib_client/michelson_v1_parser.ml @@ -125,3 +125,9 @@ let expand_expression = parse Expression String let expand_all_and_recognize_prims ~source ~original = expand_all_and_recognize_prims source original [] + +let unrecognize_prims parsed = + { + parsed with + expanded = Michelson_v1_primitives.strings_of_prims parsed.expanded; + } diff --git a/src/proto_alpha/lib_client/michelson_v1_parser.mli b/src/proto_alpha/lib_client/michelson_v1_parser.mli index 5f547e845439..f4b914a6ea1c 100644 --- a/src/proto_alpha/lib_client/michelson_v1_parser.mli +++ b/src/proto_alpha/lib_client/michelson_v1_parser.mli @@ -65,3 +65,5 @@ val expand_all_and_recognize_prims : source:string -> original:Micheline_parser.node -> parsed Micheline_parser.parsing_result + +val unrecognize_prims : parsed -> string parser_result diff --git a/src/proto_alpha/lib_client/michelson_v1_printer.ml b/src/proto_alpha/lib_client/michelson_v1_printer.ml index c375f30dd393..44568e84a439 100644 --- a/src/proto_alpha/lib_client/michelson_v1_printer.ml +++ b/src/proto_alpha/lib_client/michelson_v1_printer.ml @@ -191,7 +191,7 @@ let unparse_invalid expanded = |> Micheline_printer.printable (fun n -> n) |> Format.asprintf "%a" Micheline_printer.print_expr_unwrapped in - fst (Michelson_v1_parser.parse_toplevel source) + fst (Michelson_v1_parser.expand_toplevel source) let ocaml_constructor_of_prim prim = (* Assuming all the prim constructor prefixes match the diff --git a/src/proto_alpha/lib_client/michelson_v1_printer.mli b/src/proto_alpha/lib_client/michelson_v1_printer.mli index c719145fa8b5..01ee9c498a11 100644 --- a/src/proto_alpha/lib_client/michelson_v1_printer.mli +++ b/src/proto_alpha/lib_client/michelson_v1_printer.mli @@ -59,7 +59,8 @@ val unparse_expression : Script.expr -> Michelson_v1_parser.parsed (** Unexpand the macros and produce the result of parsing an intermediate pretty printed source. Works on generic trees,for programs that fail to be converted to a specific script version. *) -val unparse_invalid : string Micheline.canonical -> Michelson_v1_parser.parsed +val unparse_invalid : + string Micheline.canonical -> string Michelson_v1_parser.parser_result val ocaml_constructor_of_prim : Michelson_v1_primitives.prim -> string diff --git a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml index 9eb52904092f..33bddc6c4d9f 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml @@ -209,7 +209,7 @@ let commands () = (fun ppf () -> Michelson_v1_error_reporter.report_errors ~details:(not no_print_source) - ~parsed + ~parsed:(Michelson_v1_parser.unrecognize_prims parsed) ~show_source:(not no_print_source) ppf errors) -- GitLab From 20158bd8b689700ea329b44eb5dc72be31258f49 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Fri, 28 Feb 2020 12:05:13 +0100 Subject: [PATCH 2/3] Client/Michelson: add minimal client support for TZT This commit adds a `run unit tests` command in the client which can be used to run a set of unit tests similarly to how `typecheck script` can be used to type check that a set of scripts. The support for the TZT format added in this commit is very minimal; only the mandatory primitives `input`, `output`, and `code` are recognized. --- .../lib_client/client_proto_tzt.ml | 62 ++++++ .../lib_client/client_proto_tzt.mli | 19 ++ .../lib_client/michelson_v1_stack.ml | 183 +++++++++++++++++- .../lib_client/michelson_v1_stack.mli | 13 ++ .../client_proto_programs_commands.ml | 105 ++++++++++ 5 files changed, 381 insertions(+), 1 deletion(-) create mode 100644 src/proto_alpha/lib_client/client_proto_tzt.ml create mode 100644 src/proto_alpha/lib_client/client_proto_tzt.mli diff --git a/src/proto_alpha/lib_client/client_proto_tzt.ml b/src/proto_alpha/lib_client/client_proto_tzt.ml new file mode 100644 index 000000000000..a83b5894ad14 --- /dev/null +++ b/src/proto_alpha/lib_client/client_proto_tzt.ml @@ -0,0 +1,62 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2023 Nomadic Labs *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +type unit_test_with_source = { + source : string; + parsed : string Michelson_v1_parser.parser_result; +} + +let print_stack out l = Michelson_v1_printer.print_typed_stack out l + +let run_unit_test (cctxt : #Protocol_client_context.rpc_context) + ~(chain : Chain_services.chain) ~block ~(test : unit_test_with_source) () = + let open Lwt_result_syntax in + let*? ut = Michelson_v1_stack.parse_unit_test test.parsed in + let* chain_id = Chain_services.chain_id cctxt ~chain () in + let amount = Tez.zero in + let* expected_output = + Plugin.RPC.Scripts.normalize_stack + cctxt + (chain, block) + ~stack:ut.output + ~unparsing_mode:Readable + ~legacy:true + ~other_contracts:None + ~extra_big_maps:None + in + let* output, _gas = + Plugin.RPC.Scripts.run_instr + ~legacy:true + ~gas:None + ~input:ut.input + ~code:ut.code + ~now:None + ~level:None + ~sender:None + ~source:None + ~chain_id + ~self:None + ~parameter:None + ~amount + ~balance:None + ~other_contracts:None + ~extra_big_maps:None + ~unparsing_mode:None + cctxt + (chain, block) + in + if output = expected_output then return_unit + else + failwith + "Output: %a@.Expected: %a@." + print_stack + output + print_stack + expected_output diff --git a/src/proto_alpha/lib_client/client_proto_tzt.mli b/src/proto_alpha/lib_client/client_proto_tzt.mli new file mode 100644 index 000000000000..0d4c9998059c --- /dev/null +++ b/src/proto_alpha/lib_client/client_proto_tzt.mli @@ -0,0 +1,19 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2023 Nomadic Labs *) +(* *) +(*****************************************************************************) + +type unit_test_with_source = { + source : string; + parsed : string Michelson_v1_parser.parser_result; +} + +val run_unit_test : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + test:unit_test_with_source -> + unit -> + unit tzresult Lwt.t diff --git a/src/proto_alpha/lib_client/michelson_v1_stack.ml b/src/proto_alpha/lib_client/michelson_v1_stack.ml index a8bf55830929..70732e703a49 100644 --- a/src/proto_alpha/lib_client/michelson_v1_stack.ml +++ b/src/proto_alpha/lib_client/michelson_v1_stack.ml @@ -91,6 +91,12 @@ type error += | Wrong_extra_big_maps_item of localized_node | Wrong_extra_big_maps of localized_node | Invalid_address_for_smart_contract of string + | Duplicated_tzt_top_prim of string * localized_node + | Wrong_tzt_top_prim_arity of string * localized_node * int + | Unknown_tzt_top_prim of string * localized_node + | Missing_mandatory_tzt_top_prim of string + | Invalid_format_for_tzt_top_prim of string * localized_node + | Invalid_tzt_toplevel of localized_node let () = Protocol_client_context.register_error_kind @@ -212,7 +218,116 @@ let () = in base58 checked notation starting with 'KT1', but given '%s'" literal) (function Invalid_address_for_smart_contract str -> Some str | _ -> None) - (fun str -> Invalid_address_for_smart_contract str) + (fun str -> Invalid_address_for_smart_contract str) ; + Protocol_client_context.register_error_kind + `Permanent + ~id:"tzt.wrong_toplevel_arity" + ~title:"Wrong arity for a TZT toplevel primitive" + ~description:"A known toplevel TZT primitive was used with a bad arity." + ~pp:(fun ppf (prim, node, arity) -> + Format.fprintf + ppf + "%a,@ Wrong arity for TZT toplevel primitive %s, expected %d \ + arguments, got %a" + print_localized_node_location + node + prim + arity + print_localized_node + node) + Data_encoding.( + obj3 + (req "prim" string) + (req "node" localized_node_encoding) + (req "arity" int16)) + (function + | Wrong_tzt_top_prim_arity (prim, node, arity) -> Some (prim, node, arity) + | _ -> None) + (fun (prim, node, arity) -> Wrong_tzt_top_prim_arity (prim, node, arity)) ; + Protocol_client_context.register_error_kind + `Permanent + ~id:"tzt.duplicated_toplevel" + ~title:"Duplicated TZT toplevel primitive" + ~description:"A toplevel TZT primitive was used several times." + ~pp:(fun ppf (prim, node) -> + Format.fprintf + ppf + "%a,@ The TZT toplevel primitive %s, cannot be used because it has \ + already been used. A TZT toplevel primitive can only be used once per \ + unit test." + print_localized_node_location + node + prim) + Data_encoding.( + obj2 (req "prim" string) (req "node" localized_node_encoding)) + (function + | Duplicated_tzt_top_prim (prim, node) -> Some (prim, node) | _ -> None) + (fun (prim, node) -> Duplicated_tzt_top_prim (prim, node)) ; + Protocol_client_context.register_error_kind + `Permanent + ~id:"tzt.unknown_toplevel" + ~title:"Unknown TZT toplevel primitive" + ~description:"A toplevel TZT primitive was unknown." + ~pp:(fun ppf (prim, node) -> + Format.fprintf + ppf + "%a,@ The TZT toplevel primitive %s is unknown." + print_localized_node_location + node + prim) + Data_encoding.( + obj2 (req "prim" string) (req "node" localized_node_encoding)) + (function + | Unknown_tzt_top_prim (prim, node) -> Some (prim, node) | _ -> None) + (fun (prim, node) -> Unknown_tzt_top_prim (prim, node)) ; + Protocol_client_context.register_error_kind + `Permanent + ~id:"tzt.missing_mandatory" + ~title:"Missing TZT mandatory toplevel primitive" + ~description:"A mandatory toplevel TZT primitive was missing." + ~pp:(fun ppf prim -> + Format.fprintf + ppf + "The mandatory TZT toplevel primitive %s is missing." + prim) + Data_encoding.(obj1 (req "prim" string)) + (function Missing_mandatory_tzt_top_prim prim -> Some prim | _ -> None) + (fun prim -> Missing_mandatory_tzt_top_prim prim) ; + Protocol_client_context.register_error_kind + `Permanent + ~id:"tzt.invalid_format" + ~title:"Invalid format for a TZT toplevel primitive" + ~description:"Invalid format for a TZT toplevel primitive" + ~pp:(fun ppf (prim, node) -> + Format.fprintf + ppf + "%a,@ Invalid format for TZT toplevel primitive %s." + print_localized_node_location + node + prim) + Data_encoding.( + obj2 (req "prim" string) (req "node" localized_node_encoding)) + (function + | Invalid_format_for_tzt_top_prim (prim, node) -> Some (prim, node) + | _ -> None) + (fun (prim, node) -> Invalid_format_for_tzt_top_prim (prim, node)) ; + Protocol_client_context.register_error_kind + `Permanent + ~id:"tzt.invalid_toplevel" + ~title:"Invalid format for TZT toplevel entry" + ~description:"Invalid format for a TZT toplevel entry" + ~pp:(fun ppf node -> + Format.fprintf + ppf + "%a,@ Invalid format for TZT toplevel entry, expected a sequence of \ + primitive applications, got %a." + print_localized_node_location + node + print_localized_node + node) + localized_node_encoding + (function Invalid_tzt_toplevel node -> Some node | _ -> None) + (fun node -> Invalid_tzt_toplevel node) let parse_expression (node : (_, string) Micheline.node) = Environment.wrap_tzresult @@ -289,3 +404,69 @@ let parse_extra_big_maps ?node parsed = ~parsed ~error:(fun node -> Wrong_extra_big_maps node) parse_extra_big_map_item + +type unit_test = { + input : (Script.expr * Script.expr) list; + code : Script.expr; + output : (Script.expr * Script.expr) list; +} + +(* Same as unit_test but all fields are optional. Used only during + parsing. *) +type temp_unit_test = { + temp_input : (Script.expr * Script.expr) list option; + temp_code : Script.expr option; + temp_output : (Script.expr * Script.expr) list option; +} + +let parse_unit_test (parsed : string Michelson_v1_parser.parser_result) = + let open Result_syntax in + let open Micheline in + let rec parse ut = function + | [] -> return ut + | (Prim (_loc, prim, [arg], _annots) as e) :: l -> ( + let check_duplicated = function + | None -> return_unit + | Some _ -> + tzfail (Duplicated_tzt_top_prim (prim, localize_node ~parsed e)) + in + let invalid_format () = + Invalid_format_for_tzt_top_prim (prim, localize_node ~parsed e) + in + let trace_invalid_format res = record_trace_eval invalid_format res in + match prim with + | "input" -> + let* () = check_duplicated ut.temp_input in + let* items = trace_invalid_format @@ parse_stack ~node:arg parsed in + parse {ut with temp_input = Some items} l + | "output" -> + let* () = check_duplicated ut.temp_output in + let* items = trace_invalid_format @@ parse_stack ~node:arg parsed in + parse {ut with temp_output = Some items} l + | "code" -> + let* () = check_duplicated ut.temp_code in + let* c = trace_invalid_format @@ parse_expression arg in + parse {ut with temp_code = Some c} l + | _ -> tzfail @@ Unknown_tzt_top_prim (prim, localize_node ~parsed e)) + | (Prim (_loc, prim, ([] | _ :: _ :: _), _annots) as e) :: _ -> + tzfail @@ Wrong_tzt_top_prim_arity (prim, localize_node ~parsed e, 1) + | ((Seq _ | Int _ | String _ | Bytes _) as e) :: _ -> + tzfail @@ Invalid_tzt_toplevel (localize_node ~parsed e) + in + let nodes = + match Micheline.root parsed.expanded with + | Seq (_, nodes) -> nodes + | node -> [node] + in + let* ut = + parse {temp_input = None; temp_code = None; temp_output = None} nodes + in + let check_mandatory opt prim = + Option.value_e + opt + ~error:(TzTrace.make @@ Missing_mandatory_tzt_top_prim prim) + in + let* input = check_mandatory ut.temp_input "input" in + let* code = check_mandatory ut.temp_code "code" in + let* output = check_mandatory ut.temp_output "output" in + return {input; code; output} diff --git a/src/proto_alpha/lib_client/michelson_v1_stack.mli b/src/proto_alpha/lib_client/michelson_v1_stack.mli index 7501aa09f6e1..675758873474 100644 --- a/src/proto_alpha/lib_client/michelson_v1_stack.mli +++ b/src/proto_alpha/lib_client/michelson_v1_stack.mli @@ -19,6 +19,10 @@ type error += | Wrong_extra_big_maps_item of localized_node | Wrong_extra_big_maps of localized_node | Invalid_address_for_smart_contract of string + | Duplicated_tzt_top_prim of string * localized_node + | Wrong_tzt_top_prim_arity of string * localized_node * int + | Unknown_tzt_top_prim of string * localized_node + | Missing_mandatory_tzt_top_prim of string val print_localized_node_location : Format.formatter -> localized_node -> unit @@ -38,3 +42,12 @@ val parse_extra_big_maps : ?node:(Micheline.canonical_location, string) Micheline.node -> string Michelson_v1_parser.parser_result -> RPC.Scripts.S.extra_big_map_description list tzresult + +type unit_test = { + input : (Script.expr * Script.expr) list; + code : Script.expr; + output : (Script.expr * Script.expr) list; +} + +val parse_unit_test : + string Michelson_v1_parser.parser_result -> unit_test tzresult diff --git a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml index 33bddc6c4d9f..e6b159dc5f61 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml @@ -457,6 +457,111 @@ let commands () = in let*! () = cctxt#message "%d" code_size in return_unit); + command + ~group + ~desc:"Ask the node to run Michelson unit tests from files or literals" + no_options + (prefixes ["run"; "unit"; "tests"; "from"] + @@ seq_of_param + @@ file_or_literal_with_origin_param ()) + (fun () tests (cctxt : Protocol_client_context.full) -> + let open Lwt_result_syntax in + match tests with + | [] -> + let*! () = + cctxt#warning "No test file was specified on the command line" + in + return_unit + | _ :: _ -> + let*! ( (_number_of_literals : int), + number_of_seen_tests, + number_of_passed_tests, + errors ) = + List.fold_left_s + (fun (i, number_of_seen_tests, number_of_passed_tests, error_acc) + content_with_origin -> + let name, i = + match content_with_origin with + | Client_proto_args.File {path; _} -> (path, i) + | Text _ -> + let i = i + 1 in + ("Literal script " ^ string_of_int i, i) + in + let source = + Client_proto_args.content_of_file_or_text + content_with_origin + in + let parsed, parsing_errors = + Michelson_v1_parser.expand_toplevel source + in + let*! res = + let open Client_proto_tzt in + let*? (test : unit_test_with_source) = + Micheline_parser.no_parsing_error + ({source; parsed}, parsing_errors) + in + run_unit_test + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~test + () + in + match res with + | Ok () -> + Lwt.return + ( i, + number_of_seen_tests + 1, + number_of_passed_tests + 1, + error_acc ) + | Error err -> + Lwt.return + ( i, + number_of_seen_tests + 1, + number_of_passed_tests, + (name, parsed, err) :: error_acc )) + (0, 0, 0, []) + tests + in + let number_of_failed_tests = + number_of_seen_tests - number_of_passed_tests + in + let print_result () = + cctxt#message + "Test results: Passed:%d Failed:%d Total:%d" + number_of_passed_tests + number_of_failed_tests + number_of_seen_tests + in + if number_of_failed_tests > 0 then + let*! () = + List.iter_s + (fun (name, parsed, errs) -> + let*! errs = + Michelson_v1_error_reporter.enrich_runtime_errors + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~parsed:(Some parsed) + errs + in + cctxt#message + "%s:@.%a" + name + (Michelson_v1_error_reporter.report_errors + ~details:true + ~parsed + ~show_source:true) + errs) + errors + in + let*! () = print_result () in + let*! () = cctxt#error "Some tests have failed" in + return_unit + else + let*! () = print_result () in + let*! () = cctxt#message "All tests have passed" in + return_unit); command ~group ~desc:"Ask the node to typecheck one or several scripts." -- GitLab From d7c7392f53d3b027220384187fa1201e399ea893 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 21 Nov 2023 11:58:40 +0100 Subject: [PATCH 3/3] Changelog: mention !10898 --- CHANGES.rst | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGES.rst b/CHANGES.rst index f0375df2ba5f..602761778ff1 100644 --- a/CHANGES.rst +++ b/CHANGES.rst @@ -78,6 +78,11 @@ Client instructions have been deprecated. Using them now displays a warning message on stderr. +- Added a ``run unit tests`` client command allowing to run one or + several Michelson unit tests in `TZT format + `__. (MR + :gl:`!10898`) + Baker ----- -- GitLab