From 4449389ef2caa01ddedb417e2cac8ca9026d84e1 Mon Sep 17 00:00:00 2001
From: Tom Jack <tom@tomjack.co>
Date: Sat, 1 Dec 2018 12:10:29 +0000
Subject: [PATCH] Michelson: fix roman numeral DIP unexpansion

---
 src/proto_alpha/lib_client/michelson_v1_macros.ml      | 10 +++++++++-
 .../lib_delegate/test/test_michelson_parser.ml         |  4 ++++
 2 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_client/michelson_v1_macros.ml b/src/proto_alpha/lib_client/michelson_v1_macros.ml
index 8e253279b..478ab4de0 100644
--- a/src/proto_alpha/lib_client/michelson_v1_macros.ml
+++ b/src/proto_alpha/lib_client/michelson_v1_macros.ml
@@ -821,6 +821,14 @@ let roman_of_decimal decimal =
       digit "I" "V" "X" x in
   String.concat "" (to_roman decimal)
 
+let dxiiivp_roman_of_decimal decimal =
+  let roman = roman_of_decimal decimal in
+  if String.length roman = 1 then
+    (* too short for D*P, fall back to IIIII... *)
+    String.concat "" (List.init decimal (fun _ -> "I"))
+  else
+    roman
+
 let unexpand_dxiiivp expanded =
   match expanded with
   | Seq (loc,
@@ -831,7 +839,7 @@ let unexpand_dxiiivp expanded =
         | Seq (_, [ Prim (_, "DIP", [ sub ], []) ]) -> count (acc + 1) sub
         | sub -> (acc, sub) in
       let depth, sub = count 1 sub in
-      let name = "D" ^ roman_of_decimal depth ^ "P" in
+      let name = "D" ^ dxiiivp_roman_of_decimal depth ^ "P" in
       Some (Prim (loc, name, [ sub ], []))
   | _ -> None
 
diff --git a/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml b/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml
index efab13fcf..8119006ad 100644
--- a/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml
+++ b/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml
@@ -190,6 +190,10 @@ let test_unexpansion_consistency () =
   assert_unexpansion_consistent (Prim (zero_loc, "UNPAPAPAIR", [], [])) >>? fun () ->
   assert_unexpansion_consistent
     (Prim (zero_loc, "DIIIP", [ Seq (zero_loc, [ Prim (zero_loc, "DROP", [], []) ]) ], [])) >>? fun () ->
+  assert_unexpansion_consistent
+    (Prim (zero_loc, "DIVP", [ Seq (zero_loc, [ Prim (zero_loc, "DROP", [], []) ]) ], [])) >>? fun () ->
+  assert_unexpansion_consistent
+    (Prim (zero_loc, "DIIIIIP", [ Seq (zero_loc, [ Prim (zero_loc, "DROP", [], []) ]) ], [])) >>? fun () ->
   assert_unexpansion_consistent (Prim (zero_loc, "SET_CAR", [], [])) >>? fun () ->
   assert_unexpansion_consistent (Prim (zero_loc, "SET_CDR", [], [])) >>? fun () ->
   assert_unexpansion_consistent (Prim (zero_loc, "DUP", [], [])) >>? fun () ->