diff --git a/src/bin/expect_tests/michelson_converter.ml b/src/bin/expect_tests/michelson_converter.ml index 2570892d3..f1437f44f 100644 --- a/src/bin/expect_tests/michelson_converter.ml +++ b/src/bin/expect_tests/michelson_converter.ml @@ -180,4 +180,26 @@ let%expect_test _ = [%expect {| { parameter (pair (pair (int %foo) (nat %bar)) (string %baz)) ; storage unit ; - code { UNIT ; NIL operation ; PAIR ; DIP { DROP } } } |}] \ No newline at end of file + code { UNIT ; NIL operation ; PAIR ; DIP { DROP } } } |}] + +let%expect_test _ = + run_ligo_good [ "compile-contract" ; (contract "michelson_converter_mixed_pair_or.mligo") ; "main2" ] ; + [%expect {| + { parameter + (or (pair %option1 (string %bar) (nat %baz)) (pair %option2 (string %bar) (nat %baz))) ; + storage nat ; + code { DUP ; + CAR ; + IF_LEFT + { DUP ; LEFT (pair (string %bar) (nat %baz)) ; DIP { DROP } } + { DUP ; RIGHT (pair (string %bar) (nat %baz)) ; DIP { DROP } } ; + DUP ; + IF_LEFT + { DUP ; LEFT (pair (string %bar) (nat %baz)) ; DIP { DROP } } + { DUP ; RIGHT (pair (string %bar) (nat %baz)) ; DIP { DROP } } ; + DIP { DROP } ; + DUP ; + IF_LEFT + { DUP ; CDR ; NIL operation ; PAIR ; DIP { DROP } } + { DUP ; CDR ; NIL operation ; PAIR ; DIP { DROP } } ; + DIP { DROP 2 } } } |}] \ No newline at end of file diff --git a/src/stages/4-ast_typed/helpers.ml b/src/stages/4-ast_typed/helpers.ml index 8911c5605..e7b2c7ac1 100644 --- a/src/stages/4-ast_typed/helpers.ml +++ b/src/stages/4-ast_typed/helpers.ml @@ -179,4 +179,5 @@ let is_michelson_pair (t: _ label_map) = | Some _ -> true | None -> prev) false - l + l && + List.for_all (fun i -> LMap.mem i t) @@ (label_range 0 (LMap.cardinal t)) diff --git a/src/test/contracts/michelson_converter_mixed_pair_or.mligo b/src/test/contracts/michelson_converter_mixed_pair_or.mligo new file mode 100644 index 000000000..349e8f92b --- /dev/null +++ b/src/test/contracts/michelson_converter_mixed_pair_or.mligo @@ -0,0 +1,34 @@ + +type foo = { + bar : string; + baz : nat; +} + +type foo_michelson = foo michelson_pair_right_comb + +type union1 = +| Choice1 of foo +| Choice2 of foo + +type union1_aux = +| Option1 of foo_michelson +| Option2 of foo_michelson + +type union1_michelson = union1_aux michelson_or_right_comb + +let union1_from_michelson (m : union1_michelson) : union1 = + let aux : union1_aux = Layout.convert_from_right_comb m in + match aux with + | Option1 fm -> + let f : foo = Layout.convert_from_right_comb fm in + Choice1 f +| Option2 fm -> + let f : foo = Layout.convert_from_right_comb fm in + Choice2 f + +let main2 (pm, s : union1_michelson * nat) = + let p = union1_from_michelson pm in + match p with + | Choice1 f -> ([] : operation list), f.baz + | Choice2 f -> ([] : operation list), f.baz +