From e69662efa529e3cb506b2d6f1d08fbad0a895005 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Tue, 6 Jun 2017 19:39:46 +0200
Subject: [PATCH] Alpha: consistent typechecking of contract storage
initialization.
---
src/proto/alpha/apply.ml | 10 ++++++----
src/proto/alpha/script_ir_translator.ml | 6 +++++-
2 files changed, 11 insertions(+), 5 deletions(-)
diff --git a/src/proto/alpha/apply.ml b/src/proto/alpha/apply.ml
index 067be76c4..9e7fab479 100644
--- a/src/proto/alpha/apply.ml
+++ b/src/proto/alpha/apply.ml
@@ -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
diff --git a/src/proto/alpha/script_ir_translator.ml b/src/proto/alpha/script_ir_translator.ml
index 341a4d9f8..0c43a4e8f 100644
--- a/src/proto/alpha/script_ir_translator.ml
+++ b/src/proto/alpha/script_ir_translator.ml
@@ -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 })