From 7df03e52aeb65c7853ff0b9180bb5e7eb73c2290 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:28:13 +0100 Subject: [PATCH 1/9] Proto/Michelson: better location for inconsistent types errors --- .../lib_protocol/script_ir_translator.ml | 39 +++++++++++-------- 1 file changed, 22 insertions(+), 17 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 7036bc9a6aac..f306eee0b652 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -689,10 +689,10 @@ let type_metadata_eq : fun ~error_details {size = size_a} {size = size_b} -> Type_size.check_eq ~error_details size_a size_b -let default_ty_eq_error ty1 ty2 = +let default_ty_eq_error loc ty1 ty2 = let ty1 = serialize_ty_for_error ty1 in let ty2 = serialize_ty_for_error ty2 in - Inconsistent_types (None, ty1, ty2) + Inconsistent_types (Some loc, ty1, ty2) (* Check that two comparable types are equal. @@ -702,11 +702,12 @@ let default_ty_eq_error ty1 ty2 = let rec comparable_ty_eq : type ta tb error_trace. error_details:error_trace error_details -> + Script.location -> ta comparable_ty -> tb comparable_ty -> ((ta comparable_ty, tb comparable_ty) eq, error_trace) Gas_monad.t = let open Gas_monad in - fun ~error_details ta tb -> + fun ~error_details loc ta tb -> let open Gas_monad.Syntax in let* () = Gas_monad.consume_gas Typecheck_costs.merge_cycle in let type_metadata_eq meta_a meta_b = @@ -717,7 +718,7 @@ let rec comparable_ty_eq : @@ Error (match error_details with | Fast -> (Inconsistent_types_fast : error_trace) - | Informative -> trace_of_error @@ default_ty_eq_error ta tb) + | Informative -> trace_of_error @@ default_ty_eq_error loc ta tb) in match (ta, tb) with | (Unit_t, Unit_t) -> return (Eq : (ta comparable_ty, tb comparable_ty) eq) @@ -753,20 +754,20 @@ let rec comparable_ty_eq : | ( Pair_t (left_a, right_a, meta_a, YesYes), Pair_t (left_b, right_b, meta_b, YesYes) ) -> let* () = type_metadata_eq meta_a meta_b in - let* Eq = comparable_ty_eq ~error_details left_a left_b in - let+ Eq = comparable_ty_eq ~error_details right_a right_b in + let* Eq = comparable_ty_eq ~error_details loc left_a left_b in + let+ Eq = comparable_ty_eq ~error_details loc right_a right_b in (Eq : (ta comparable_ty, tb comparable_ty) eq) | (Pair_t _, _) -> not_equal () | ( Union_t (left_a, right_a, meta_a, YesYes), Union_t (left_b, right_b, meta_b, YesYes) ) -> let* () = type_metadata_eq meta_a meta_b in - let* Eq = comparable_ty_eq ~error_details left_a left_b in - let+ Eq = comparable_ty_eq ~error_details right_a right_b in + let* Eq = comparable_ty_eq ~error_details loc left_a left_b in + let+ Eq = comparable_ty_eq ~error_details loc right_a right_b in (Eq : (ta comparable_ty, tb comparable_ty) eq) | (Union_t _, _) -> not_equal () | (Option_t (ta, meta_a, Yes), Option_t (tb, meta_b, Yes)) -> let* () = type_metadata_eq meta_a meta_b in - let+ Eq = comparable_ty_eq ~error_details ta tb in + let+ Eq = comparable_ty_eq ~error_details loc ta tb in (Eq : (ta comparable_ty, tb comparable_ty) eq) | (Option_t _, _) -> not_equal () @@ -811,7 +812,7 @@ let ty_eq : fun ty1 ty2 -> help0 ty1 ty2 |> Gas_monad.record_trace_eval ~error_details (fun () -> - default_ty_eq_error ty1 ty2) + default_ty_eq_error loc ty1 ty2) and help0 : type ta tac tb tbc. (ta, tac) ty -> @@ -825,7 +826,7 @@ let ty_eq : @@ Error (match error_details with | Fast -> (Inconsistent_types_fast : error_trace) - | Informative -> trace_of_error @@ default_ty_eq_error ty1 ty2) + | Informative -> trace_of_error @@ default_ty_eq_error loc ty1 ty2) in match (ty1, ty2) with | (Unit_t, Unit_t) -> return (Eq : ((ta, tac) ty, (tb, tbc) ty) eq) @@ -869,23 +870,23 @@ let ty_eq : | (Map_t (tal, tar, meta1), Map_t (tbl, tbr, meta2)) -> let* () = type_metadata_eq meta1 meta2 in let* Eq = help tar tbr in - let+ Eq = comparable_ty_eq ~error_details tal tbl in + let+ Eq = comparable_ty_eq ~error_details loc tal tbl in (Eq : ((ta, tac) ty, (tb, tbc) ty) eq) | (Map_t _, _) -> not_equal () | (Big_map_t (tal, tar, meta1), Big_map_t (tbl, tbr, meta2)) -> let* () = type_metadata_eq meta1 meta2 in let* Eq = help tar tbr in - let+ Eq = comparable_ty_eq ~error_details tal tbl in + let+ Eq = comparable_ty_eq ~error_details loc tal tbl in (Eq : ((ta, tac) ty, (tb, tbc) ty) eq) | (Big_map_t _, _) -> not_equal () | (Set_t (ea, meta1), Set_t (eb, meta2)) -> let* () = type_metadata_eq meta1 meta2 in - let+ Eq = comparable_ty_eq ~error_details ea eb in + let+ Eq = comparable_ty_eq ~error_details loc ea eb in (Eq : ((ta, tac) ty, (tb, tbc) ty) eq) | (Set_t _, _) -> not_equal () | (Ticket_t (ea, meta1), Ticket_t (eb, meta2)) -> let* () = type_metadata_eq meta1 meta2 in - let+ Eq = comparable_ty_eq ~error_details ea eb in + let+ Eq = comparable_ty_eq ~error_details loc ea eb in (Eq : ((ta, tac) ty, (tb, tbc) ty) eq) | (Ticket_t _, _) -> not_equal () | (Pair_t (tal, tar, meta1, cmp1), Pair_t (tbl, tbr, meta2, cmp2)) -> @@ -2766,7 +2767,7 @@ let[@coq_axiom_with_reason "gadt"] rec parse_data : @@ let open Gas_monad.Syntax in let* Eq = - comparable_ty_eq ~error_details:Informative tk btk + comparable_ty_eq ~error_details:Informative loc tk btk in ty_eq ~error_details:Informative loc tv btv) >>? fun (eq, ctxt) -> @@ -4818,7 +4819,11 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : rest ) ) -> check_var_annot loc annot >>?= fun () -> Gas_monad.run ctxt - @@ comparable_ty_eq ~error_details:Informative contents_ty_a contents_ty_b + @@ comparable_ty_eq + ~error_details:Informative + loc + contents_ty_a + contents_ty_b >>?= fun (eq, ctxt) -> eq >>?= fun Eq -> option_t loc ty_a >>?= fun res_ty -> -- GitLab From 731c9bc263a4f5a4dd002fc3ccfae17b54b50dd3 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:29:27 +0100 Subject: [PATCH 2/9] Proto/Michelson: simplify Inconsistent_types error `location` doesn't need to be an option any longer --- src/proto_alpha/lib_client/michelson_v1_error_reporter.ml | 6 +++--- src/proto_alpha/lib_protocol/script_ir_translator.ml | 4 ++-- src/proto_alpha/lib_protocol/script_tc_errors.ml | 4 +--- .../lib_protocol/script_tc_errors_registration.ml | 2 +- 4 files changed, 7 insertions(+), 9 deletions(-) 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 b1b78b40cc4a..6db6d970d166 100644 --- a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml +++ b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml @@ -745,13 +745,13 @@ let report_errors ~details ~show_source ?parsed ppf errs = "@[@[Type@ %a@]@ is not comparable.@]" print_ty ty - | Inconsistent_types (opt_loc, tya, tyb) -> + | Inconsistent_types (loc, tya, tyb) -> Format.fprintf ppf "@[@[%aType@ %a@]@ @[is not compatible with \ type@ %a.@]@]" - (fun fmt -> function None -> () | Some loc -> print_loc fmt loc) - opt_loc + print_loc + loc print_ty tya print_ty diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index f306eee0b652..e305c05e4177 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -692,7 +692,7 @@ let type_metadata_eq : let default_ty_eq_error loc ty1 ty2 = let ty1 = serialize_ty_for_error ty1 in let ty2 = serialize_ty_for_error ty2 in - Inconsistent_types (Some loc, ty1, ty2) + Inconsistent_types (loc, ty1, ty2) (* Check that two comparable types are equal. @@ -799,7 +799,7 @@ let ty_eq : |> Gas_monad.record_trace_eval ~error_details (fun () -> let ty1 = serialize_ty_for_error ty1 in let ty2 = serialize_ty_for_error ty2 in - Inconsistent_types (Some loc, ty1, ty2)) + Inconsistent_types (loc, ty1, ty2)) in let memo_size_eq ms1 ms2 = Gas_monad.of_result (memo_size_eq ~error_details ms1 ms2) diff --git a/src/proto_alpha/lib_protocol/script_tc_errors.ml b/src/proto_alpha/lib_protocol/script_tc_errors.ml index 6e5846a1e7ae..15d25a3d7483 100644 --- a/src/proto_alpha/lib_protocol/script_tc_errors.ml +++ b/src/proto_alpha/lib_protocol/script_tc_errors.ml @@ -159,9 +159,7 @@ type error += Comparable_type_expected : Script.location * Script.expr -> error type error += Inconsistent_type_sizes : int * int -> error type error += - | Inconsistent_types : - Script.location option * Script.expr * Script.expr - -> error + | Inconsistent_types : Script.location * Script.expr * Script.expr -> error type error += | Inconsistent_memo_sizes : Sapling.Memo_size.t * Sapling.Memo_size.t -> error diff --git a/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml b/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml index 0b92547fd14a..ef1974cc3e79 100644 --- a/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml +++ b/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml @@ -573,7 +573,7 @@ let () = where the equality of two types have to be proven, it is always \ accompanied with another error that provides more context." (obj3 - (opt "loc" Script.location_encoding) + (req "loc" Script.location_encoding) (req "first_type" Script.expr_encoding) (req "other_type" Script.expr_encoding)) (function -- GitLab From 922049c7eb4195232d9dc5fa32f24178166e2c9d Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:23:33 +0100 Subject: [PATCH 3/9] Proto/Michelson: remove comparable_ty_eq replaced by `ty_eq` --- .../lib_protocol/script_ir_translator.ml | 103 ++---------------- 1 file changed, 12 insertions(+), 91 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index e305c05e4177..d2683a396e3d 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -694,83 +694,6 @@ let default_ty_eq_error loc ty1 ty2 = let ty2 = serialize_ty_for_error ty2 in Inconsistent_types (loc, ty1, ty2) -(* Check that two comparable types are equal. - - The result is an equality witness between the types of the two inputs within - the gas monad (for gas consumption). - *) -let rec comparable_ty_eq : - type ta tb error_trace. - error_details:error_trace error_details -> - Script.location -> - ta comparable_ty -> - tb comparable_ty -> - ((ta comparable_ty, tb comparable_ty) eq, error_trace) Gas_monad.t = - let open Gas_monad in - fun ~error_details loc ta tb -> - let open Gas_monad.Syntax in - let* () = Gas_monad.consume_gas Typecheck_costs.merge_cycle in - let type_metadata_eq meta_a meta_b = - of_result @@ type_metadata_eq ~error_details meta_a meta_b - in - let not_equal () = - of_result - @@ Error - (match error_details with - | Fast -> (Inconsistent_types_fast : error_trace) - | Informative -> trace_of_error @@ default_ty_eq_error loc ta tb) - in - match (ta, tb) with - | (Unit_t, Unit_t) -> return (Eq : (ta comparable_ty, tb comparable_ty) eq) - | (Unit_t, _) -> not_equal () - | (Never_t, Never_t) -> return Eq - | (Never_t, _) -> not_equal () - | (Int_t, Int_t) -> return Eq - | (Int_t, _) -> not_equal () - | (Nat_t, Nat_t) -> return Eq - | (Nat_t, _) -> not_equal () - | (Signature_t, Signature_t) -> return Eq - | (Signature_t, _) -> not_equal () - | (String_t, String_t) -> return Eq - | (String_t, _) -> not_equal () - | (Bytes_t, Bytes_t) -> return Eq - | (Bytes_t, _) -> not_equal () - | (Mutez_t, Mutez_t) -> return Eq - | (Mutez_t, _) -> not_equal () - | (Bool_t, Bool_t) -> return Eq - | (Bool_t, _) -> not_equal () - | (Key_hash_t, Key_hash_t) -> return Eq - | (Key_hash_t, _) -> not_equal () - | (Key_t, Key_t) -> return Eq - | (Key_t, _) -> not_equal () - | (Timestamp_t, Timestamp_t) -> return Eq - | (Timestamp_t, _) -> not_equal () - | (Chain_id_t, Chain_id_t) -> return Eq - | (Chain_id_t, _) -> not_equal () - | (Address_t, Address_t) -> return Eq - | (Address_t, _) -> not_equal () - | (Tx_rollup_l2_address_t, Tx_rollup_l2_address_t) -> return Eq - | (Tx_rollup_l2_address_t, _) -> not_equal () - | ( Pair_t (left_a, right_a, meta_a, YesYes), - Pair_t (left_b, right_b, meta_b, YesYes) ) -> - let* () = type_metadata_eq meta_a meta_b in - let* Eq = comparable_ty_eq ~error_details loc left_a left_b in - let+ Eq = comparable_ty_eq ~error_details loc right_a right_b in - (Eq : (ta comparable_ty, tb comparable_ty) eq) - | (Pair_t _, _) -> not_equal () - | ( Union_t (left_a, right_a, meta_a, YesYes), - Union_t (left_b, right_b, meta_b, YesYes) ) -> - let* () = type_metadata_eq meta_a meta_b in - let* Eq = comparable_ty_eq ~error_details loc left_a left_b in - let+ Eq = comparable_ty_eq ~error_details loc right_a right_b in - (Eq : (ta comparable_ty, tb comparable_ty) eq) - | (Union_t _, _) -> not_equal () - | (Option_t (ta, meta_a, Yes), Option_t (tb, meta_b, Yes)) -> - let* () = type_metadata_eq meta_a meta_b in - let+ Eq = comparable_ty_eq ~error_details loc ta tb in - (Eq : (ta comparable_ty, tb comparable_ty) eq) - | (Option_t _, _) -> not_equal () - let memo_size_eq : type error_trace. error_details:error_trace error_details -> @@ -785,8 +708,12 @@ let memo_size_eq : | Fast -> Inconsistent_types_fast | Informative -> trace_of_error @@ Inconsistent_memo_sizes (ms1, ms2)) -(** Same as comparable_ty_eq but for any types. *) -let ty_eq : +(* Check that two types are equal. + + The result is an equality witness between the types of the two inputs within + the gas monad (for gas consumption). + *) +let rec ty_eq : type a ac b bc error_trace. error_details:error_trace error_details -> Script.location -> @@ -870,23 +797,23 @@ let ty_eq : | (Map_t (tal, tar, meta1), Map_t (tbl, tbr, meta2)) -> let* () = type_metadata_eq meta1 meta2 in let* Eq = help tar tbr in - let+ Eq = comparable_ty_eq ~error_details loc tal tbl in + let+ Eq = ty_eq ~error_details loc tal tbl in (Eq : ((ta, tac) ty, (tb, tbc) ty) eq) | (Map_t _, _) -> not_equal () | (Big_map_t (tal, tar, meta1), Big_map_t (tbl, tbr, meta2)) -> let* () = type_metadata_eq meta1 meta2 in let* Eq = help tar tbr in - let+ Eq = comparable_ty_eq ~error_details loc tal tbl in + let+ Eq = ty_eq ~error_details loc tal tbl in (Eq : ((ta, tac) ty, (tb, tbc) ty) eq) | (Big_map_t _, _) -> not_equal () | (Set_t (ea, meta1), Set_t (eb, meta2)) -> let* () = type_metadata_eq meta1 meta2 in - let+ Eq = comparable_ty_eq ~error_details loc ea eb in + let+ Eq = ty_eq ~error_details loc ea eb in (Eq : ((ta, tac) ty, (tb, tbc) ty) eq) | (Set_t _, _) -> not_equal () | (Ticket_t (ea, meta1), Ticket_t (eb, meta2)) -> let* () = type_metadata_eq meta1 meta2 in - let+ Eq = comparable_ty_eq ~error_details loc ea eb in + let+ Eq = ty_eq ~error_details loc ea eb in (Eq : ((ta, tac) ty, (tb, tbc) ty) eq) | (Ticket_t _, _) -> not_equal () | (Pair_t (tal, tar, meta1, cmp1), Pair_t (tbl, tbr, meta2, cmp2)) -> @@ -2766,9 +2693,7 @@ let[@coq_axiom_with_reason "gadt"] rec parse_data : (Gas_monad.run ctxt @@ let open Gas_monad.Syntax in - let* Eq = - comparable_ty_eq ~error_details:Informative loc tk btk - in + let* Eq = ty_eq ~error_details:Informative loc tk btk in ty_eq ~error_details:Informative loc tv btv) >>? fun (eq, ctxt) -> eq >|? fun Eq -> (Some id, ctxt) ) @@ -4819,11 +4744,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : rest ) ) -> check_var_annot loc annot >>?= fun () -> Gas_monad.run ctxt - @@ comparable_ty_eq - ~error_details:Informative - loc - contents_ty_a - contents_ty_b + @@ ty_eq ~error_details:Informative loc contents_ty_a contents_ty_b >>?= fun (eq, ctxt) -> eq >>?= fun Eq -> option_t loc ty_a >>?= fun res_ty -> -- GitLab From c09c9a6be4598308049a8c937be9b435c5203864 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:37:39 +0100 Subject: [PATCH 4/9] Proto/Michelson: remove comparable_comb_witness1 --- src/proto_alpha/lib_protocol/script_ir_translator.ml | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index d2683a396e3d..694da913452c 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -2282,8 +2282,8 @@ let parse_option parse_v ctxt ~legacy = function (* -- parse data of comparable types -- *) -let comparable_comb_witness1 : - type t. t comparable_ty -> (t, unit -> unit) comb_witness = function +let comb_witness1 : type t tc. (t, tc) ty -> (t, unit -> unit) comb_witness = + function | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any @@ -2334,7 +2334,7 @@ let[@coq_axiom_with_reason "gadt"] rec parse_comparable_data : | (Tx_rollup_l2_address_t, expr) -> Lwt.return @@ traced_no_lwt @@ parse_tx_rollup_l2_address ctxt expr | (Pair_t (tl, tr, _, YesYes), expr) -> - let r_witness = comparable_comb_witness1 tr in + let r_witness = comb_witness1 tr in let parse_l ctxt v = parse_comparable_data ?type_logger ctxt tl v in let parse_r ctxt v = parse_comparable_data ?type_logger ctxt tr v in traced @@ parse_pair parse_l parse_r ctxt ~legacy r_witness expr @@ -2349,11 +2349,6 @@ let[@coq_axiom_with_reason "gadt"] rec parse_comparable_data : (* -- parse data of any type -- *) -let comb_witness1 : type t tc. (t, tc) ty -> (t, unit -> unit) comb_witness = - function - | Pair_t _ -> Comb_Pair Comb_Any - | _ -> Comb_Any - (* Some values, such as operations, tickets, or big map ids, are used only internally and are not allowed to be forged by users. -- GitLab From 5320c432c93ae0810c0ee2a28cc7563bc81c41f6 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:48:49 +0100 Subject: [PATCH 5/9] Proto/Michelson: remove comparable_comb_witness2 --- .../lib_protocol/script_ir_translator.ml | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 694da913452c..0e2d823144ef 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -526,9 +526,9 @@ let unparse_option ~loc unparse_v ctxt = function (* -- Unparsing data of comparable types -- *) -let comparable_comb_witness2 : - type t. t comparable_ty -> (t, unit -> unit -> unit) comb_witness = function - | Pair_t (_, Pair_t _, _, YesYes) -> Comb_Pair (Comb_Pair Comb_Any) +let comb_witness2 : + type t tc. (t, tc) ty -> (t, unit -> unit -> unit) comb_witness = function + | Pair_t (_, Pair_t _, _, _) -> Comb_Pair (Comb_Pair Comb_Any) | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any @@ -568,7 +568,7 @@ let[@coq_axiom_with_reason "gadt"] rec unparse_comparable_data : | (Chain_id_t, chain_id) -> Lwt.return @@ unparse_chain_id ~loc ctxt mode chain_id | (Pair_t (tl, tr, _, YesYes), pair) -> - let r_witness = comparable_comb_witness2 tr in + let r_witness = comb_witness2 tr in let unparse_l ctxt v = unparse_comparable_data ~loc ctxt mode tl v in let unparse_r ctxt v = unparse_comparable_data ~loc ctxt mode tr v in unparse_pair ~loc unparse_l unparse_r ctxt mode r_witness pair @@ -5484,12 +5484,6 @@ let list_entrypoints_uncarbonated (type full fullc) (full : (full, fullc) ty) (* -- Unparsing data of any type -- *) -let comb_witness2 : - type t tc. (t, tc) ty -> (t, unit -> unit -> unit) comb_witness = function - | Pair_t (_, Pair_t _, _, _) -> Comb_Pair (Comb_Pair Comb_Any) - | Pair_t _ -> Comb_Pair Comb_Any - | _ -> Comb_Any - let[@coq_axiom_with_reason "gadt"] rec unparse_data : type a ac. context -> -- GitLab From 6b3a5ac533eafa31b445da968a73ec803a936468 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Mon, 14 Mar 2022 19:52:18 +0100 Subject: [PATCH 6/9] Proto/Benchmarks: simplify tnames_of_type --- .../lib_benchmark/test/test_distribution.ml | 40 ++----------------- 1 file changed, 4 insertions(+), 36 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/test/test_distribution.ml b/src/proto_alpha/lib_benchmark/test/test_distribution.ml index f8380845c297..440adbdaac1f 100644 --- a/src/proto_alpha/lib_benchmark/test/test_distribution.ml +++ b/src/proto_alpha/lib_benchmark/test/test_distribution.ml @@ -78,11 +78,11 @@ let rec tnames_of_type : tnames_of_type dom (tnames_of_type range (`TLambda :: acc)) | Script_typed_ir.Option_t (ty, _, _) -> tnames_of_type ty (`TOption :: acc) | Script_typed_ir.List_t (ty, _) -> tnames_of_type ty (`TList :: acc) - | Script_typed_ir.Set_t (ty, _) -> tnames_of_comparable_type ty (`TSet :: acc) + | Script_typed_ir.Set_t (ty, _) -> tnames_of_type ty (`TSet :: acc) | Script_typed_ir.Map_t (kty, vty, _) -> - tnames_of_comparable_type kty (tnames_of_type vty (`TMap :: acc)) + tnames_of_type kty (tnames_of_type vty (`TMap :: acc)) | Script_typed_ir.Big_map_t (kty, vty, _) -> - tnames_of_comparable_type kty (tnames_of_type vty (`TBig_map :: acc)) + tnames_of_type kty (tnames_of_type vty (`TBig_map :: acc)) | Script_typed_ir.Contract_t (ty, _) -> tnames_of_type ty (`TContract :: acc) | Script_typed_ir.Sapling_transaction_t _ -> `TSapling_transaction :: acc | Script_typed_ir.Sapling_transaction_deprecated_t _ -> @@ -94,42 +94,10 @@ let rec tnames_of_type : | Script_typed_ir.Bls12_381_g1_t -> `TBls12_381_g1 :: acc | Script_typed_ir.Bls12_381_g2_t -> `TBls12_381_g2 :: acc | Script_typed_ir.Bls12_381_fr_t -> `TBls12_381_fr :: acc - | Script_typed_ir.Ticket_t (ty, _) -> - tnames_of_comparable_type ty (`TTicket :: acc) + | Script_typed_ir.Ticket_t (ty, _) -> tnames_of_type ty (`TTicket :: acc) | Script_typed_ir.Chest_key_t -> assert false | Script_typed_ir.Chest_t -> assert false -and tnames_of_comparable_type : - type a. a Script_typed_ir.comparable_ty -> type_name list -> type_name list - = - fun t acc -> - match t with - | Script_typed_ir.Unit_t -> `TUnit :: acc - | Script_typed_ir.Never_t -> assert false - | Script_typed_ir.Int_t -> `TInt :: acc - | Script_typed_ir.Nat_t -> `TNat :: acc - | Script_typed_ir.Signature_t -> `TSignature :: acc - | Script_typed_ir.String_t -> `TString :: acc - | Script_typed_ir.Bytes_t -> `TBytes :: acc - | Script_typed_ir.Mutez_t -> `TMutez :: acc - | Script_typed_ir.Bool_t -> `TBool :: acc - | Script_typed_ir.Key_hash_t -> `TKey_hash :: acc - | Script_typed_ir.Key_t -> `TKey :: acc - | Script_typed_ir.Timestamp_t -> `TTimestamp :: acc - | Script_typed_ir.Chain_id_t -> `TChain_id :: acc - | Script_typed_ir.Address_t -> `TAddress :: acc - | Script_typed_ir.Tx_rollup_l2_address_t -> `TTx_rollup_l2_address :: acc - | Script_typed_ir.Pair_t (lty, rty, _, YesYes) -> - tnames_of_comparable_type - lty - (tnames_of_comparable_type rty (`TPair :: acc)) - | Script_typed_ir.Union_t (lty, rty, _, YesYes) -> - tnames_of_comparable_type - lty - (tnames_of_comparable_type rty (`TUnion :: acc)) - | Script_typed_ir.Option_t (ty, _, Yes) -> - tnames_of_comparable_type ty (`TOption :: acc) - module Crypto_samplers = Crypto_samplers.Make_finite_key_pool (struct let algo = `Default -- GitLab From e008c26cc9ea295add34dbf83cff5210762dab28 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Tue, 19 Apr 2022 15:51:16 +0200 Subject: [PATCH 7/9] Tests/python: remove duplicate test --- tests_python/tests_alpha/test_contract.py | 5 ----- 1 file changed, 5 deletions(-) diff --git a/tests_python/tests_alpha/test_contract.py b/tests_python/tests_alpha/test_contract.py index 953ceb6fe1c1..ecee6a89c19a 100644 --- a/tests_python/tests_alpha/test_contract.py +++ b/tests_python/tests_alpha/test_contract.py @@ -550,11 +550,6 @@ class TestContracts: ("big_dip.tz", r'expected a positive 10-bit integer'), # error message for DROP over the limit ("big_drop.tz", r'expected a positive 10-bit integer'), - # error message for set update on non-comparable type - ( - "set_update_non_comparable.tz", - r'Type nat is not compatible with type list operation', - ), # error message for attempting to push a value of type never ("never_literal.tz", r'type never has no inhabitant.'), # COMB, UNCOMB, and DUP cannot take 0 as argument -- GitLab From 15459dd7e97f78fdd37f041410707365e54b3351 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Tue, 19 Apr 2022 16:04:32 +0200 Subject: [PATCH 8/9] Tests/python: make run failure matching multiline --- tests_python/tools/utils.py | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/tests_python/tools/utils.py b/tests_python/tools/utils.py index 6b1d5871a683..73cc261e47b9 100644 --- a/tests_python/tools/utils.py +++ b/tests_python/tools/utils.py @@ -438,18 +438,13 @@ def assert_run_failure(pattern: str, mode: str = 'stderr'): yield None assert False, "Code ran without throwing exception" except subprocess.CalledProcessError as exc: - stdout_output = exc.stdout - stderr_output = exc.stderr - data = [] # type: List[str] if mode == 'stderr': - data = stderr_output.split('\n') + output = exc.stderr else: - data = stdout_output.split('\n') - for line in data: - if re.search(pattern, line): - return - data_pretty = "\n".join(data) - assert False, f"Could not find '{pattern}' in '{data_pretty}'" + output = exc.stdout + if re.search(pattern, output): + return + assert False, f"Could not find '{pattern}' in '{output}'" except Exception as exc: # pylint: disable=broad-except assert_msg = f'Expected CalledProcessError but got {type(exc)}' assert False, assert_msg -- GitLab From 45a8a9ccdff4be245ca59c10a56a0559d2452575 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Tue, 19 Apr 2022 16:04:54 +0200 Subject: [PATCH 9/9] Tests/python: update error pattern --- tests_python/tests_alpha/test_contract.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests_python/tests_alpha/test_contract.py b/tests_python/tests_alpha/test_contract.py index ecee6a89c19a..7fff2787e825 100644 --- a/tests_python/tests_alpha/test_contract.py +++ b/tests_python/tests_alpha/test_contract.py @@ -539,7 +539,7 @@ class TestContracts: # error message for set update on non-comparable type ( "set_update_non_comparable.tz", - r'Type nat is not compatible with type list operation', + r'Type nat\s+is not compatible with type list operation', ), # error message for the arity of the chain_id type ( -- GitLab