Alpha: some missing gas in parse_data
This commit is contained in:
parent
5d4101d85a
commit
2db455274c
@ -210,7 +210,7 @@ assert_storage $contract_dir/exec_concat.tz '"?"' '""' '"_abc"'
|
|||||||
assert_storage $contract_dir/exec_concat.tz '"?"' '"test"' '"test_abc"'
|
assert_storage $contract_dir/exec_concat.tz '"?"' '"test"' '"test_abc"'
|
||||||
|
|
||||||
# Get current steps to quota
|
# 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
|
# Get the current balance of the contract
|
||||||
assert_storage $contract_dir/balance.tz '111' Unit '4000000000000'
|
assert_storage $contract_dir/balance.tz '111' Unit '4000000000000'
|
||||||
|
@ -34,6 +34,9 @@ module Cost_of = struct
|
|||||||
let bytes length =
|
let bytes length =
|
||||||
alloc_mbytes_cost length
|
alloc_mbytes_cost length
|
||||||
|
|
||||||
|
let zint z =
|
||||||
|
alloc_bits_cost (Z.numbits z)
|
||||||
|
|
||||||
let concat s1 s2 =
|
let concat s1 s2 =
|
||||||
string (String.length s1 + String.length s2)
|
string (String.length s1 + String.length s2)
|
||||||
|
|
||||||
@ -209,6 +212,7 @@ module Cost_of = struct
|
|||||||
let unit = free
|
let unit = free
|
||||||
let string = string
|
let string = string
|
||||||
let bytes = bytes
|
let bytes = bytes
|
||||||
|
let z = zint
|
||||||
let int_of_string str =
|
let int_of_string str =
|
||||||
alloc_cost @@ (Pervasives.(/) (String.length str) 5)
|
alloc_cost @@ (Pervasives.(/) (String.length str) 5)
|
||||||
let tez = step_cost 1 +@ alloc_cost 1
|
let tez = step_cost 1 +@ alloc_cost 1
|
||||||
|
@ -98,6 +98,7 @@ module Cost_of : sig
|
|||||||
val unit : Gas.cost
|
val unit : Gas.cost
|
||||||
val bool : Gas.cost
|
val bool : Gas.cost
|
||||||
val tez : Gas.cost
|
val tez : Gas.cost
|
||||||
|
val z : Z.t -> Gas.cost
|
||||||
val string : int -> Gas.cost
|
val string : int -> Gas.cost
|
||||||
val bytes : int -> Gas.cost
|
val bytes : int -> Gas.cost
|
||||||
val int_of_string : string -> Gas.cost
|
val int_of_string : string -> Gas.cost
|
||||||
|
@ -1297,10 +1297,10 @@ let rec parse_data
|
|||||||
traced (fail (Invalid_kind (location expr, [ Bytes_kind ], kind expr)))
|
traced (fail (Invalid_kind (location expr, [ Bytes_kind ], kind expr)))
|
||||||
(* Integers *)
|
(* Integers *)
|
||||||
| Int_t _, Int (_, v) ->
|
| Int_t _, Int (_, v) ->
|
||||||
(* TODO gas *)
|
Lwt.return (Gas.consume ctxt (Typecheck_costs.z v)) >>=? fun ctxt ->
|
||||||
return (Script_int.of_zint v, ctxt)
|
return (Script_int.of_zint v, ctxt)
|
||||||
| Nat_t _, Int (_, v) ->
|
| 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
|
let v = Script_int.of_zint v in
|
||||||
if Compare.Int.(Script_int.compare v Script_int.zero >= 0) then
|
if Compare.Int.(Script_int.compare v Script_int.zero >= 0) then
|
||||||
return (Script_int.abs v, ctxt)
|
return (Script_int.abs v, ctxt)
|
||||||
@ -1312,7 +1312,10 @@ let rec parse_data
|
|||||||
traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))
|
traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))
|
||||||
(* Tez amounts *)
|
(* Tez amounts *)
|
||||||
| Mutez_t _, Int (_, v) ->
|
| 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
|
begin try
|
||||||
match Tez.of_mutez (Z.to_int64 v) with
|
match Tez.of_mutez (Z.to_int64 v) with
|
||||||
| None -> raise Exit
|
| None -> raise Exit
|
||||||
@ -1324,7 +1327,7 @@ let rec parse_data
|
|||||||
traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))
|
traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))
|
||||||
(* Timestamps *)
|
(* Timestamps *)
|
||||||
| Timestamp_t _, (Int (_, v)) (* As unparsed with [Optimized] or out of bounds [Readable]. *) ->
|
| 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)
|
return (Script_timestamp.of_zint v, ctxt)
|
||||||
| Timestamp_t _, String (_, s) (* As unparsed with [Redable]. *) ->
|
| Timestamp_t _, String (_, s) (* As unparsed with [Redable]. *) ->
|
||||||
Lwt.return (Gas.consume ctxt Typecheck_costs.string_timestamp) >>=? fun ctxt ->
|
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 ]))
|
traced (fail (unexpected expr [] Constant_namespace [ D_Some ; D_None ]))
|
||||||
(* Lists *)
|
(* Lists *)
|
||||||
| List_t (t, _ty_name), Seq (_loc, items) ->
|
| List_t (t, _ty_name), Seq (_loc, items) ->
|
||||||
(* TODO gas *)
|
|
||||||
traced @@
|
traced @@
|
||||||
fold_right_s
|
fold_right_s
|
||||||
(fun v (rest, ctxt) ->
|
(fun v (rest, ctxt) ->
|
||||||
@ -1485,7 +1487,6 @@ let rec parse_data
|
|||||||
traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
|
traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
|
||||||
(* Sets *)
|
(* Sets *)
|
||||||
| Set_t (t, _ty_name), (Seq (loc, vs) as expr) ->
|
| Set_t (t, _ty_name), (Seq (loc, vs) as expr) ->
|
||||||
(* TODO gas *)
|
|
||||||
let length = List.length vs in
|
let length = List.length vs in
|
||||||
traced @@
|
traced @@
|
||||||
fold_left_s
|
fold_left_s
|
||||||
@ -1510,12 +1511,10 @@ let rec parse_data
|
|||||||
traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
|
traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
|
||||||
(* Maps *)
|
(* Maps *)
|
||||||
| Map_t (tk, tv, _ty_name), (Seq (loc, vs) as expr) ->
|
| 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)
|
parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> x)
|
||||||
| Map_t _, expr ->
|
| Map_t _, expr ->
|
||||||
traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
|
traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
|
||||||
| Big_map_t (tk, tv, _ty_name), (Seq (loc, vs) as 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) ->
|
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)
|
({ diff ; key_type = ty_of_comparable_ty tk ; value_type = tv }, ctxt)
|
||||||
| Big_map_t (_tk, _tv, _), expr ->
|
| Big_map_t (_tk, _tv, _), expr ->
|
||||||
|
Loading…
Reference in New Issue
Block a user