diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 18576a06e..580952231 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -502,9 +502,9 @@ module Contract : sig val is_spendable: context -> contract -> bool tzresult Lwt.t val get_script: - context -> contract -> (Script.t option) tzresult Lwt.t + context -> contract -> (context * Script.t option) tzresult Lwt.t val get_storage: - context -> contract -> (Script.expr option) tzresult Lwt.t + context -> contract -> (context * Script.expr option) tzresult Lwt.t val get_counter: context -> contract -> int32 tzresult Lwt.t val get_balance: @@ -546,13 +546,13 @@ module Contract : sig module Big_map : sig val set: - context -> contract -> - string -> Script.expr -> context tzresult Lwt.t + context -> contract -> string -> Script.expr -> context tzresult Lwt.t val remove: context -> contract -> string -> context tzresult Lwt.t - val mem: context -> contract -> string -> bool Lwt.t + val mem: + context -> contract -> string -> (context * bool) tzresult Lwt.t val get_opt: - context -> contract -> string -> Script_repr.expr option tzresult Lwt.t + context -> contract -> string -> (context * Script_repr.expr option) tzresult Lwt.t end end diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index 7ccfb5377..11c0ea2b4 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -376,7 +376,7 @@ let apply_manager_operation_content begin Contract.spend ctxt source amount >>=? fun ctxt -> Contract.credit ctxt destination amount >>=? fun ctxt -> - Contract.get_script ctxt destination >>=? function + Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with | None -> begin match parameters with | None -> diff --git a/src/proto_alpha/lib_protocol/src/contract_services.ml b/src/proto_alpha/lib_protocol/src/contract_services.ml index 13014ef95..7b054b87d 100644 --- a/src/proto_alpha/lib_protocol/src/contract_services.ml +++ b/src/proto_alpha/lib_protocol/src/contract_services.ml @@ -170,8 +170,10 @@ let () = register_field S.counter Contract.get_counter ; register_field S.spendable Contract.is_spendable ; register_field S.delegatable Contract.is_delegatable ; - register_opt_field S.script Contract.get_script ; - register_opt_field S.storage Contract.get_storage ; + register_opt_field S.script + (fun c v -> Contract.get_script c v >>=? fun (_, v) -> return v) ; + register_opt_field S.storage + (fun c v -> Contract.get_storage c v >>=? fun (_, v) -> return v) ; register_field S.info (fun ctxt contract -> Contract.get_balance ctxt contract >>=? fun balance -> Contract.get_manager ctxt contract >>=? fun manager -> @@ -179,8 +181,8 @@ let () = Contract.get_counter ctxt contract >>=? fun counter -> Contract.is_delegatable ctxt contract >>=? fun delegatable -> Contract.is_spendable ctxt contract >>=? fun spendable -> - Contract.get_script ctxt contract >>=? fun script -> - Contract.get_storage ctxt contract >>=? fun storage -> + Contract.get_script ctxt contract >>=? fun (ctxt, script) -> + Contract.get_storage ctxt contract >>=? fun (_ctxt, storage) -> return { manager ; balance ; spendable ; delegate = (delegatable, delegate) ; script ; counter ; storage}) diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.ml b/src/proto_alpha/lib_protocol/src/contract_storage.ml index db7e27a70..10134619b 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.ml +++ b/src/proto_alpha/lib_protocol/src/contract_storage.ml @@ -200,8 +200,8 @@ let create_base c contract Storage.Contract.Counter.init c contract counter >>=? fun c -> (match script with | Some ({ Script_repr.code ; storage }, (code_fees, storage_fees)) -> - Storage.Contract.Code.init c contract code >>=? fun c -> - Storage.Contract.Storage.init c contract storage >>=? fun c -> + Storage.Contract.Code.init c contract code >>=? fun (c, _) -> + Storage.Contract.Storage.init c contract storage >>=? fun (c, _) -> Storage.Contract.Code_fees.init c contract code_fees >>=? fun c -> Storage.Contract.Storage_fees.init c contract storage_fees | None -> @@ -225,11 +225,11 @@ let delete c contract = Storage.Contract.Spendable.del c contract >>= fun c -> Storage.Contract.Delegatable.del c contract >>= fun c -> Storage.Contract.Counter.delete c contract >>=? fun c -> - Storage.Contract.Code.remove c contract >>= fun c -> - Storage.Contract.Storage.remove c contract >>= fun c -> + Storage.Contract.Code.remove c contract >>=? fun (c, _) -> + Storage.Contract.Storage.remove c contract >>=? fun (c, _) -> Storage.Contract.Code_fees.remove c contract >>= fun c -> Storage.Contract.Storage_fees.remove c contract >>= fun c -> - Storage.Contract.Big_map.clear (c, contract) >>= fun c -> + Storage.Contract.Big_map.clear (c, contract) >>=? fun c -> return c let allocated c contract = @@ -274,11 +274,11 @@ let increment_counter c contract = Storage.Contract.Counter.set c contract (Int32.succ contract_counter) let get_script c contract = - Storage.Contract.Code.get_option c contract >>=? fun code -> - Storage.Contract.Storage.get_option c contract >>=? fun storage -> + Storage.Contract.Code.get_option c contract >>=? fun (c, code) -> + Storage.Contract.Storage.get_option c contract >>=? fun (c, storage) -> match code, storage with - | None, None -> return None - | Some code, Some storage -> return (Some { Script_repr.code ; storage }) + | None, None -> return (c, None) + | Some code, Some storage -> return (c, Some { Script_repr.code ; storage }) | None, Some _ | Some _, None -> failwith "get_script" let get_storage = Storage.Contract.Storage.get_option @@ -364,14 +364,15 @@ let update_script_storage c contract storage big_map = fold_left_s (fun c (key, value) -> match value with | None -> - Storage.Contract.Big_map.remove (c, contract) key >>= - return + Storage.Contract.Big_map.remove (c, contract) key >>=? fun (c, _) -> + return c | Some v -> - Storage.Contract.Big_map.init_set (c, contract) key v >>= - return) + Storage.Contract.Big_map.init_set (c, contract) key v >>=? fun (c, _) -> + return c) c diff end >>=? fun c -> - Storage.Contract.Storage.set c contract storage + Storage.Contract.Storage.set c contract storage >>=? fun (c, _) -> + return c let spend_from_script c contract amount = Storage.Contract.Balance.get c contract >>=? fun balance -> @@ -393,16 +394,18 @@ let spend_from_script c contract amount = return c | None -> (* Delete empty implicit contract *) - delete c contract + delete c contract >>=? fun (c, _) -> + return c let credit c contract amount = begin if Tez_repr.(amount <> Tez_repr.zero) then - return () + return c else - Storage.Contract.Code.mem c contract >>= fun target_has_code -> - fail_unless target_has_code (Empty_transaction contract) - end >>=? fun () -> + Storage.Contract.Code.mem c contract >>=? fun (c, target_has_code) -> + fail_unless target_has_code (Empty_transaction contract) >>=? fun () -> + return c + end >>=? fun c -> Storage.Contract.Balance.get_option c contract >>=? function | None -> begin match Contract_repr.is_implicit contract with @@ -440,8 +443,13 @@ let init c = module Big_map = struct let set ctxt contract key value = - Storage.Contract.Big_map.init_set (ctxt, contract) key value >>= return - let remove ctxt contract = Storage.Contract.Big_map.delete (ctxt, contract) - let mem ctxt contract = Storage.Contract.Big_map.mem (ctxt, contract) - let get_opt ctxt contract = Storage.Contract.Big_map.get_option (ctxt, contract) + Storage.Contract.Big_map.init_set (ctxt, contract) key value >>=? fun (c, _) -> + return c + let remove ctxt contract key = + Storage.Contract.Big_map.delete (ctxt, contract) key >>=? fun (c, _) -> + return c + let mem ctxt contract key = + Storage.Contract.Big_map.mem (ctxt, contract) key + let get_opt ctxt contract key = + Storage.Contract.Big_map.get_option (ctxt, contract) key end diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.mli b/src/proto_alpha/lib_protocol/src/contract_storage.mli index 932d8cadc..45ddaf644 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.mli +++ b/src/proto_alpha/lib_protocol/src/contract_storage.mli @@ -56,9 +56,9 @@ val get_balance: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t val get_counter: Raw_context.t -> Contract_repr.t -> int32 tzresult Lwt.t val get_script: - Raw_context.t -> Contract_repr.t -> Script_repr.t option tzresult Lwt.t + Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.t option) tzresult Lwt.t val get_storage: - Raw_context.t -> Contract_repr.t -> Script_repr.expr option tzresult Lwt.t + Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t type big_map_diff = (string * Script_repr.expr option) list @@ -103,11 +103,11 @@ val init: module Big_map : sig val set : - Raw_context.t -> Contract_repr.t -> - string -> Script_repr.expr -> Raw_context.t tzresult Lwt.t + Raw_context.t -> Contract_repr.t -> string -> Script_repr.expr -> Raw_context.t tzresult Lwt.t val remove : Raw_context.t -> Contract_repr.t -> string -> Raw_context.t tzresult Lwt.t - val mem : Raw_context.t -> Contract_repr.t -> string -> bool Lwt.t + val mem : + Raw_context.t -> Contract_repr.t -> string -> (Raw_context.t * bool) tzresult Lwt.t val get_opt : - Raw_context.t -> Contract_repr.t -> string -> Script_repr.expr option tzresult Lwt.t + Raw_context.t -> Contract_repr.t -> string -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t end diff --git a/src/proto_alpha/lib_protocol/src/gas_repr.ml b/src/proto_alpha/lib_protocol/src/gas_repr.ml index 468b3f5f7..8646d2048 100644 --- a/src/proto_alpha/lib_protocol/src/gas_repr.ml +++ b/src/proto_alpha/lib_protocol/src/gas_repr.ml @@ -13,7 +13,11 @@ type t = type cost = { allocations : Z.t ; - steps : Z.t } + steps : Z.t ; + reads : Z.t ; + writes : Z.t ; + bytes_read : Z.t ; + bytes_written : Z.t } let encoding = let open Data_encoding in @@ -34,32 +38,53 @@ let pp ppf = function let cost_encoding = let open Data_encoding in conv - (fun { allocations ; steps } -> - (allocations, steps)) - (fun (allocations, steps) -> - { allocations ; steps }) - (obj2 + (fun { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } -> + (allocations, steps, reads, writes, bytes_read, bytes_written)) + (fun (allocations, steps, reads, writes, bytes_read, bytes_written) -> + { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written }) + (obj6 (req "allocations" z) - (req "steps" z)) + (req "steps" z) + (req "reads" z) + (req "writes" z) + (req "bytes_read" z) + (req "bytes_written" z)) -let pp_cost ppf { allocations ; steps } = +let pp_cost ppf { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } = Format.fprintf ppf - "(steps: %s, allocs: %s)" - (Z.to_string steps) (Z.to_string allocations) + "(steps: %s, allocs: %s, reads: %s (%s bytes), writes: %s (%s bytes))" + (Z.to_string steps) + (Z.to_string allocations) + (Z.to_string reads) + (Z.to_string bytes_read) + (Z.to_string writes) + (Z.to_string bytes_written) type error += Block_quota_exceeded (* `Temporary *) type error += Operation_quota_exceeded (* `Temporary *) -let allocation_weight = Z.of_int 2 -let step_weight = Z.of_int 1 +let allocation_weight = Z.of_int 2 (* FIXME: placeholder *) +let step_weight = Z.of_int 1 (* FIXME: placeholder *) +let read_base_weight = Z.of_int 10 (* FIXME: placeholder *) +let write_base_weight = Z.of_int 20 (* FIXME: placeholder *) +let byte_read_weight = Z.of_int 10 (* FIXME: placeholder *) +let byte_written_weight = Z.of_int 20 (* FIXME: placeholder *) let consume block_gas operation_gas cost = match operation_gas with | Unaccounted -> ok (block_gas, Unaccounted) | Limited { remaining } -> let weighted_cost = Z.add - (Z.mul allocation_weight cost.allocations) - (Z.mul step_weight cost.steps) in + (Z.add + (Z.mul allocation_weight cost.allocations) + (Z.mul step_weight cost.steps)) + (Z.add + (Z.add + (Z.mul read_base_weight cost.reads) + (Z.mul write_base_weight cost.writes)) + (Z.add + (Z.mul byte_read_weight cost.bytes_read) + (Z.mul byte_written_weight cost.bytes_written))) in let remaining = Z.sub remaining weighted_cost in let block_remaining = @@ -72,7 +97,11 @@ let consume block_gas operation_gas cost = match operation_gas with let alloc_cost n = { allocations = Z.of_int (n + 1) ; - steps = Z.zero } + steps = Z.zero ; + reads = Z.zero ; + writes = Z.zero ; + bytes_read = Z.zero ; + bytes_written = Z.zero } let alloc_bytes_cost n = alloc_cost (n / 8) @@ -82,19 +111,51 @@ let alloc_bits_cost n = let step_cost n = { allocations = Z.zero ; - steps = Z.of_int n } + steps = Z.of_int n ; + reads = Z.zero ; + writes = Z.zero ; + bytes_read = Z.zero ; + bytes_written = Z.zero } let free = { allocations = Z.zero ; - steps = Z.zero } + steps = Z.zero ; + reads = Z.zero ; + writes = Z.zero ; + bytes_read = Z.zero ; + bytes_written = Z.zero } + +let read_bytes_cost n = + { allocations = Z.zero ; + steps = Z.zero ; + reads = Z.one ; + writes = Z.zero ; + bytes_read = n ; + bytes_written = Z.zero } + +let write_bytes_cost n = + { allocations = Z.zero ; + steps = Z.zero ; + reads = Z.zero ; + writes = Z.one ; + bytes_read = Z.zero ; + bytes_written = n } let ( +@ ) x y = { allocations = Z.add x.allocations y.allocations ; - steps = Z.add x.steps y.steps } + steps = Z.add x.steps y.steps ; + reads = Z.add x.reads y.reads ; + writes = Z.add x.writes y.writes ; + bytes_read = Z.add x.bytes_read y.bytes_read ; + bytes_written = Z.add x.bytes_written y.bytes_written } let ( *@ ) x y = { allocations = Z.mul (Z.of_int x) y.allocations ; - steps = Z.mul (Z.of_int x) y.steps } + steps = Z.mul (Z.of_int x) y.steps ; + reads = Z.mul (Z.of_int x) y.reads ; + writes = Z.mul (Z.of_int x) y.writes ; + bytes_read = Z.mul (Z.of_int x) y.bytes_read ; + bytes_written = Z.mul (Z.of_int x) y.bytes_written } let () = let open Data_encoding in diff --git a/src/proto_alpha/lib_protocol/src/gas_repr.mli b/src/proto_alpha/lib_protocol/src/gas_repr.mli index e0b644426..c07512f1d 100644 --- a/src/proto_alpha/lib_protocol/src/gas_repr.mli +++ b/src/proto_alpha/lib_protocol/src/gas_repr.mli @@ -29,6 +29,8 @@ val step_cost : int -> cost val alloc_cost : int -> cost val alloc_bytes_cost : int -> cost val alloc_bits_cost : int -> cost +val read_bytes_cost : Z.t -> cost +val write_bytes_cost : Z.t -> cost val ( *@ ) : int -> cost -> cost val ( +@ ) : cost -> cost -> cost diff --git a/src/proto_alpha/lib_protocol/src/raw_context.mli b/src/proto_alpha/lib_protocol/src/raw_context.mli index 2c3875534..5a222038f 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.mli +++ b/src/proto_alpha/lib_protocol/src/raw_context.mli @@ -77,7 +77,6 @@ type error += Gas_limit_too_high (* `Permanent *) val set_gas_limit: t -> Z.t -> t tzresult val set_gas_unlimited: t -> t -val consume_gas: t -> Gas_repr.cost -> t tzresult val gas_level: t -> Gas_repr.t val block_gas_level: t -> Z.t diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index be0bc2f7f..92b5b118d 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -648,7 +648,7 @@ let rec interp Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt -> Contract.spend_from_script ctxt source amount >>=? fun ctxt -> Contract.credit ctxt destination amount >>=? fun ctxt -> - Contract.get_script ctxt destination >>=? fun destination_script -> + Contract.get_script ctxt destination >>=? fun (ctxt, destination_script) -> Lwt.return (unparse_data ctxt storage_type storage) >>=? fun (sto, ctxt) -> let sto = Micheline.strip_locations sto in begin match Script_ir_translator.extract_big_map storage_type storage with @@ -685,7 +685,7 @@ let rec interp destination dummy_storage_fee >>=? fun ctxt -> return (ctxt, origination) end >>=? fun (ctxt, origination) -> - Contract.get_script ctxt source >>=? (function + Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with | None -> assert false | Some { storage; _ } -> parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) -> @@ -696,7 +696,7 @@ let rec interp Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt -> Contract.spend_from_script ctxt source amount >>=? fun ctxt -> Contract.credit ctxt destination amount >>=? fun ctxt -> - Contract.get_script ctxt destination >>=? function + Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with | None -> fail (Invalid_contract (loc, destination)) | Some script -> begin match extract_big_map storage_type sto with @@ -727,7 +727,7 @@ let rec interp trace (Invalid_contract (loc, destination)) (parse_data ctxt tr ret) >>=? fun (v, ctxt) -> - Contract.get_script ctxt source >>=? (function + Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with | None -> assert false | Some { storage ; _ } -> parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) -> diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml index 220006859..72f4d4baf 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -2159,7 +2159,7 @@ and parse_contract Lwt.return (Gas.consume ctxt Typecheck_costs.get_script) >>=? fun ctxt -> trace (Invalid_contract (loc, contract)) @@ - Contract.get_script ctxt contract >>=? function + Contract.get_script ctxt contract >>=? fun (ctxt, script) -> match script with | None -> Lwt.return (ty_eq arg Unit_t >>? fun Eq -> @@ -2303,7 +2303,7 @@ let hash_data ctxt typ data = let big_map_mem ctxt contract key { diff ; key_type ; _ } = match map_get key diff with | None -> Lwt.return @@ hash_data ctxt key_type key >>=? fun (hash, ctxt) -> - Alpha_context.Contract.Big_map.mem ctxt contract hash >>= fun res -> + Alpha_context.Contract.Big_map.mem ctxt contract hash >>=? fun (ctxt, res) -> return (res, ctxt) | Some None -> return (false, ctxt) | Some (Some _) -> return (true, ctxt) @@ -2315,10 +2315,10 @@ let big_map_get ctxt contract key { diff ; key_type ; value_type } = Lwt.return @@ hash_data ctxt key_type key >>=? fun (hash, ctxt) -> Alpha_context.Contract.Big_map.get_opt ctxt contract hash >>=? begin function - | None -> return (None, ctxt) - | Some value -> - parse_data ctxt value_type (Micheline.root value) >>|? fun (x, ctxt) -> - (Some x, ctxt) + | (ctxt, None) -> return (None, ctxt) + | (ctxt, Some value) -> + parse_data ctxt value_type (Micheline.root value) >>=? fun (x, ctxt) -> + return (Some x, ctxt) end let big_map_update key value ({ diff ; _ } as map) = diff --git a/src/proto_alpha/lib_protocol/src/storage.ml b/src/proto_alpha/lib_protocol/src/storage.ml index 130672def..0d82ffea2 100644 --- a/src/proto_alpha/lib_protocol/src/storage.ml +++ b/src/proto_alpha/lib_protocol/src/storage.ml @@ -127,17 +127,17 @@ module Contract = struct (Make_value(Int32)) module Code = - Indexed_context.Make_map + Indexed_context.Make_carbonated_map (struct let name = ["code"] end) - (Make_value(struct + (Make_carbonated_value(struct type t = Script_repr.expr let encoding = Script_repr.expr_encoding end)) module Storage = - Indexed_context.Make_map + Indexed_context.Make_carbonated_map (struct let name = ["storage"] end) - (Make_value(struct + (Make_carbonated_value(struct type t = Script_repr.expr let encoding = Script_repr.expr_encoding end)) @@ -145,12 +145,12 @@ module Contract = struct type bigmap_key = Raw_context.t * Contract_repr.t module Big_map = - Storage_functors.Make_indexed_data_storage + Storage_functors.Make_indexed_carbonated_data_storage (Make_subcontext (Indexed_context.Raw_context) (struct let name = ["big_map"] end)) (String_index) - (Make_value (struct + (Make_carbonated_value (struct type t = Script_repr.expr let encoding = Script_repr.expr_encoding end)) diff --git a/src/proto_alpha/lib_protocol/src/storage.mli b/src/proto_alpha/lib_protocol/src/storage.mli index 0d578d3ef..389aa9e32 100644 --- a/src/proto_alpha/lib_protocol/src/storage.mli +++ b/src/proto_alpha/lib_protocol/src/storage.mli @@ -156,12 +156,12 @@ module Contract : sig and type value = int32 and type t := Raw_context.t - module Code : Indexed_data_storage + module Code : Indexed_carbonated_data_storage with type key = Contract_repr.t and type value = Script_repr.expr and type t := Raw_context.t - module Storage : Indexed_data_storage + module Storage : Indexed_carbonated_data_storage with type key = Contract_repr.t and type value = Script_repr.expr and type t := Raw_context.t @@ -178,7 +178,7 @@ module Contract : sig type bigmap_key = Raw_context.t * Contract_repr.t - module Big_map : Indexed_data_storage + module Big_map : Indexed_carbonated_data_storage with type key = string and type value = Script_repr.expr and type t := bigmap_key diff --git a/src/proto_alpha/lib_protocol/src/storage_functors.ml b/src/proto_alpha/lib_protocol/src/storage_functors.ml index 00a5311e4..43b124ec7 100644 --- a/src/proto_alpha/lib_protocol/src/storage_functors.ml +++ b/src/proto_alpha/lib_protocol/src/storage_functors.ml @@ -48,7 +48,7 @@ let rec len_name = function let encode_len_value bytes = let length = MBytes.length bytes in - Data_encoding.(Binary.to_bytes int31) length + Data_encoding.(Binary.to_bytes_exn int31) length let decode_len_value key len = match Data_encoding.(Binary.of_bytes int31) len with diff --git a/src/proto_alpha/lib_protocol/test/test_big_maps.ml b/src/proto_alpha/lib_protocol/test/test_big_maps.ml index cad1fa241..37f32aa41 100644 --- a/src/proto_alpha/lib_protocol/test/test_big_maps.ml +++ b/src/proto_alpha/lib_protocol/test/test_big_maps.ml @@ -46,8 +46,8 @@ let expect_big_map tc contract print_key key_type print_data data_type contents let open Proto_alpha.Error_monad in iter_p (fun (n, exp) -> - Lwt.return @@ Proto_alpha.Script_ir_translator.hash_data tc key_type n >>=? fun (key, _tc) -> - Proto_alpha.Alpha_context.Contract.Big_map.get_opt tc contract key >>=? fun data -> + Lwt.return @@ Proto_alpha.Script_ir_translator.hash_data tc key_type n >>=? fun (key, tc) -> + Proto_alpha.Alpha_context.Contract.Big_map.get_opt tc contract key >>=? fun (_tc, data) -> match data, exp with | None, None -> debug " - big_map[%a] is not defined (ok)" print_key n ; diff --git a/src/proto_alpha/lib_protocol/test/test_michelson.ml b/src/proto_alpha/lib_protocol/test/test_michelson.ml index 35102de46..6c38e4eb4 100644 --- a/src/proto_alpha/lib_protocol/test/test_michelson.ml +++ b/src/proto_alpha/lib_protocol/test/test_michelson.ml @@ -434,7 +434,7 @@ let test_example () = test_contract ~tc "create_contract" account_str account_str >>=? fun (cs, tc) -> Assert.equal_int 1 @@ List.length cs ; let contract = List.hd cs in - Proto_alpha.Alpha_context.Contract.get_script tc contract >>=?? fun res -> + Proto_alpha.Alpha_context.Contract.get_script tc contract >>=?? fun (_, res) -> let script = Option.unopt_exn (Failure "get_script") res in Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, ret, _, _, _) -> Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon ret ;