From ee7a67b91541afe92f6f82842827230ab243efa1 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Sat, 30 Jun 2018 12:26:06 +0200
Subject: [PATCH] Michelson: fix PACK/UNPACK

---
 src/bin_client/test/contracts/packunpack.tz       |  6 ++++++
 src/bin_client/test/test_contracts.sh             |  7 +++++++
 .../lib_protocol/src/script_interpreter.ml        | 15 ++++++++++-----
 3 files changed, 23 insertions(+), 5 deletions(-)
 create mode 100644 src/bin_client/test/contracts/packunpack.tz

diff --git a/src/bin_client/test/contracts/packunpack.tz b/src/bin_client/test/contracts/packunpack.tz
new file mode 100644
index 000000000..ad313fa8a
--- /dev/null
+++ b/src/bin_client/test/contracts/packunpack.tz
@@ -0,0 +1,6 @@
+parameter (pair (pair (pair string (list int)) (set nat)) bytes) ;
+storage unit ;
+code { CAR ; UNPAIR ; DIP { DUP } ;
+       PACK ; ASSERT_CMPEQ ;
+       UNPACK (pair (pair string (list int)) (set nat)) ; ASSERT_SOME ; DROP ;
+       UNIT ; NIL operation ; PAIR }
diff --git a/src/bin_client/test/test_contracts.sh b/src/bin_client/test/test_contracts.sh
index 47cc943ab..8baa9a0ac 100755
--- a/src/bin_client/test/test_contracts.sh
+++ b/src/bin_client/test/test_contracts.sh
@@ -209,6 +209,13 @@ assert_storage $contract_dir/loop_left.tz '{""}' '{ "c" ; "b" ; "a" }' '{ "a" ;
 assert_storage $contract_dir/exec_concat.tz '"?"' '""' '"_abc"'
 assert_storage $contract_dir/exec_concat.tz '"?"' '"test"' '"test_abc"'
 
+# Test PACK/UNPACK and binary format
+assert_success $client run script $contract_dir/packunpack.tz on storage Unit and input \
+               '(Pair (Pair (Pair "toto" {3;7;9;1}) {1;2;3}) 0x05070707070100000004746f746f020000000800030007000900010200000006000100020003)'
+
+assert_fails $client run script $contract_dir/packunpack.tz on storage Unit and input \
+               '(Pair (Pair (Pair "toto" {3;7;9;1}) {1;2;3}) 0x05070707070100000004746f746f0200000008000300070009000102000000060001000200030004)'
+
 # Get current steps to quota
 assert_storage $contract_dir/steps_to_quota.tz 111 Unit 399813
 
diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml
index 4dfbcfe35..622b8976c 100644
--- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml
@@ -641,19 +641,24 @@ let rec interp
             Script_ir_translator.pack_data ctxt t value >>=? fun (bytes, ctxt) ->
             logged_return (Item (bytes, rest), ctxt)
         | Unpack t, Item (bytes, rest) ->
-            begin match Data_encoding.Binary.of_bytes Script.lazy_expr_encoding bytes with
+            Lwt.return (Gas.check_enough ctxt (Script.serialized_cost bytes)) >>=? fun () ->
+            if Compare.Int.(MBytes.length bytes >= 1) &&
+               Compare.Int.(MBytes.get_uint8 bytes 0 = 0x05) then
+              let bytes = MBytes.sub bytes 1 (MBytes.length bytes - 1) in
+              match Data_encoding.Binary.of_bytes Script.expr_encoding bytes with
               | None ->
                   Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes)) >>=? fun ctxt ->
                   logged_return (Item (None, rest), ctxt)
-              | Some lexpr ->
-                  (Script.force_decode ctxt lexpr >>=? fun (expr, ctxt) ->
-                   parse_data ctxt t (Micheline.root expr)) >>= function
+              | Some expr ->
+                  Lwt.return (Gas.consume ctxt (Script.deserialized_cost expr)) >>=? fun ctxt ->
+                  parse_data ctxt t (Micheline.root expr) >>= function
                   | Ok (value, ctxt) ->
                       logged_return (Item (Some value, rest), ctxt)
                   | Error _ignored ->
                       Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes)) >>=? fun ctxt ->
                       logged_return (Item (None, rest), ctxt)
-            end
+            else
+              logged_return (Item (None, rest), ctxt)
         (* protocol *)
         | Address, Item ((_, contract), rest) ->
             Lwt.return (Gas.consume ctxt Interp_costs.address) >>=? fun ctxt ->