Alpha: consistent typechecking of contract storage initialization.

This commit is contained in:
Benjamin Canou 2017-06-06 19:39:46 +02:00
parent 35792ccc37
commit e69662efa5
2 changed files with 11 additions and 5 deletions

View File

@ -104,10 +104,12 @@ let apply_manager_operation_content
end
| Origination { manager ; delegate ; script ;
spendable ; delegatable ; credit } ->
let script = match script with
| None -> None
| Some script ->
Some (script, (Script_interpreter.dummy_code_fee, Script_interpreter.dummy_storage_fee)) in
begin match script with
| None -> return None
| Some ({ Script.storage ; code } as script) ->
Script_ir_translator.parse_script ctxt storage code >>=? fun _ ->
return (Some (script, (Script_interpreter.dummy_code_fee, Script_interpreter.dummy_storage_fee)))
end >>=? fun script ->
Contract.spend ctxt source Constants.origination_burn >>=? fun ctxt ->
Contract.spend ctxt source credit >>=? fun ctxt ->
Contract.originate ctxt

View File

@ -1409,12 +1409,16 @@ type ex_script = Ex_script : ('a, 'b, 'c) script -> ex_script
let parse_script
: context -> Script.storage -> Script.code -> ex_script tzresult Lwt.t
= fun ctxt { storage; storage_type } { code; arg_type; ret_type } ->
= fun ctxt
{ storage; storage_type = init_storage_type }
{ code; arg_type; ret_type; storage_type } ->
(Lwt.return (parse_ty arg_type)) >>=? fun (Ex_ty arg_type) ->
(Lwt.return (parse_ty ret_type)) >>=? fun (Ex_ty ret_type) ->
(Lwt.return (parse_ty init_storage_type)) >>=? fun (Ex_ty init_storage_type) ->
(Lwt.return (parse_ty storage_type)) >>=? fun (Ex_ty storage_type) ->
let arg_type_full = Pair_t (Pair_t (Tez_t, arg_type), storage_type) in
let ret_type_full = Pair_t (ret_type, storage_type) in
Lwt.return (ty_eq init_storage_type storage_type) >>=? fun (Eq _) ->
parse_data ctxt storage_type storage >>=? fun storage ->
parse_lambda ctxt ~storage_type arg_type_full ret_type_full code >>=? fun code ->
return (Ex_script { code; arg_type; ret_type; storage; storage_type })