From 2db455274cfe61d97be21bc370b35854a15d0d40 Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Fri, 29 Jun 2018 01:53:44 +0200 Subject: [PATCH] Alpha: some missing gas in parse_data --- src/bin_client/test/test_contracts.sh | 2 +- .../lib_protocol/src/michelson_v1_gas.ml | 4 ++++ .../lib_protocol/src/michelson_v1_gas.mli | 1 + .../lib_protocol/src/script_ir_translator.ml | 15 +++++++-------- 4 files changed, 13 insertions(+), 9 deletions(-) diff --git a/src/bin_client/test/test_contracts.sh b/src/bin_client/test/test_contracts.sh index bb575787b..1b56419e4 100755 --- a/src/bin_client/test/test_contracts.sh +++ b/src/bin_client/test/test_contracts.sh @@ -210,7 +210,7 @@ assert_storage $contract_dir/exec_concat.tz '"?"' '""' '"_abc"' assert_storage $contract_dir/exec_concat.tz '"?"' '"test"' '"test_abc"' # Get current steps to quota -assert_storage $contract_dir/steps_to_quota.tz 111 Unit 399817 +assert_storage $contract_dir/steps_to_quota.tz 111 Unit 399815 # Get the current balance of the contract assert_storage $contract_dir/balance.tz '111' Unit '4000000000000' diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml index 2998b2117..1cf4537ba 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml @@ -34,6 +34,9 @@ module Cost_of = struct let bytes length = alloc_mbytes_cost length + let zint z = + alloc_bits_cost (Z.numbits z) + let concat s1 s2 = string (String.length s1 + String.length s2) @@ -209,6 +212,7 @@ module Cost_of = struct let unit = free let string = string let bytes = bytes + let z = zint let int_of_string str = alloc_cost @@ (Pervasives.(/) (String.length str) 5) let tez = step_cost 1 +@ alloc_cost 1 diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli index 8e546b139..882bd2977 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli @@ -98,6 +98,7 @@ module Cost_of : sig val unit : Gas.cost val bool : Gas.cost val tez : Gas.cost + val z : Z.t -> Gas.cost val string : int -> Gas.cost val bytes : int -> Gas.cost val int_of_string : string -> Gas.cost 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 ccf6c0c34..713a09e40 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -1297,10 +1297,10 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ Bytes_kind ], kind expr))) (* Integers *) | Int_t _, Int (_, v) -> - (* TODO gas *) + Lwt.return (Gas.consume ctxt (Typecheck_costs.z v)) >>=? fun ctxt -> return (Script_int.of_zint v, ctxt) | Nat_t _, Int (_, v) -> - (* TODO gas *) + Lwt.return (Gas.consume ctxt (Typecheck_costs.z v)) >>=? fun ctxt -> let v = Script_int.of_zint v in if Compare.Int.(Script_int.compare v Script_int.zero >= 0) then return (Script_int.abs v, ctxt) @@ -1312,7 +1312,10 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr))) (* Tez amounts *) | Mutez_t _, Int (_, v) -> - Lwt.return (Gas.consume ctxt Typecheck_costs.tez) >>=? fun ctxt -> + Lwt.return ( + Gas.consume ctxt Typecheck_costs.tez >>? fun ctxt -> + Gas.consume ctxt Michelson_v1_gas.Cost_of.z_to_int64 + ) >>=? fun ctxt -> begin try match Tez.of_mutez (Z.to_int64 v) with | None -> raise Exit @@ -1324,7 +1327,7 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr))) (* Timestamps *) | Timestamp_t _, (Int (_, v)) (* As unparsed with [Optimized] or out of bounds [Readable]. *) -> - (* TODO gas *) + Lwt.return (Gas.consume ctxt (Typecheck_costs.z v)) >>=? fun ctxt -> return (Script_timestamp.of_zint v, ctxt) | Timestamp_t _, String (_, s) (* As unparsed with [Redable]. *) -> Lwt.return (Gas.consume ctxt Typecheck_costs.string_timestamp) >>=? fun ctxt -> @@ -1473,7 +1476,6 @@ let rec parse_data traced (fail (unexpected expr [] Constant_namespace [ D_Some ; D_None ])) (* Lists *) | List_t (t, _ty_name), Seq (_loc, items) -> - (* TODO gas *) traced @@ fold_right_s (fun v (rest, ctxt) -> @@ -1485,7 +1487,6 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr))) (* Sets *) | Set_t (t, _ty_name), (Seq (loc, vs) as expr) -> - (* TODO gas *) let length = List.length vs in traced @@ fold_left_s @@ -1510,12 +1511,10 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr))) (* Maps *) | Map_t (tk, tv, _ty_name), (Seq (loc, vs) as expr) -> - (* TODO gas *) parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> x) | Map_t _, expr -> traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr))) | Big_map_t (tk, tv, _ty_name), (Seq (loc, vs) as expr) -> - (* TODO gas *) parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> Some x) >>|? fun (diff, ctxt) -> ({ diff ; key_type = ty_of_comparable_ty tk ; value_type = tv }, ctxt) | Big_map_t (_tk, _tv, _), expr ->