diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index bacbfc8e2..facee666d 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -1130,4 +1130,18 @@ let%expect_test _ = let%expect_test _ = run_ligo_good [ "dry-run" ; contract "super-counter.mligo" ; "main" ; "test_param" ; "test_storage" ] ; [%expect {| - ( list[] , 3 ) |}] \ No newline at end of file + ( list[] , 3 ) |}] + +let%expect_test _ = + run_ligo_bad [ "compile-contract" ; bad_contract "redundant_constructors.mligo" ; "main" ] ; + [%expect {| + ligo: redundant constructor: {"constructor":"Add","environment":"- E[]\tT[union_a -> sum[Add -> int , Remove -> int]] ]"} + + + If you're not sure how to fix this error, you can + do one of the following: + + * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ + * Ask a question on our Discord: https://discord.gg/9rhYaEt + * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new + * Check the changelog by running 'ligo changelog' |}] \ No newline at end of file diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/4-typer-old/typer.ml index 87f4b2477..2d5d70a12 100644 --- a/src/passes/4-typer-old/typer.ml +++ b/src/passes/4-typer-old/typer.ml @@ -80,6 +80,15 @@ module Errors = struct ] in error ~data title message () + let redundant_constructor (e:environment) (c:I.constructor') () = + let title = (thunk "redundant constructor") in + let message () = "" in + let data = [ + ("constructor" , fun () -> Format.asprintf "%a" I.PP.constructor c); + ("environment" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ; + ] in + error ~data title message () + let wrong_arity (n:string) (expected:int) (actual:int) (loc : Location.t) () = let title () = "wrong arity" in let message () = "" in @@ -321,6 +330,9 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu let aux k v prev = let%bind prev' = prev in let%bind v' = evaluate_type e v in + let%bind () = match Environment.get_constructor k e with + | Some _ -> fail (redundant_constructor e k) + | None -> ok () in ok @@ I.CMap.add k v' prev' in let%bind m = I.CMap.fold aux m (ok I.CMap.empty) in diff --git a/src/test/contracts/negative/redundant_constructors.mligo b/src/test/contracts/negative/redundant_constructors.mligo new file mode 100644 index 000000000..ffa4ec6c6 --- /dev/null +++ b/src/test/contracts/negative/redundant_constructors.mligo @@ -0,0 +1,20 @@ +type union_a = +| Add of int +| Remove of int + +(* comment this type out to successfully compile the contract *) +type union_b = +| Add of nat +| Remove of nat +| Config of nat + + +let foo (a : union_a) = + match a with + |Add a -> unit + |Remove b -> unit + + +let main(p, s : union_a * unit) : (operation list) * unit = + let ss = foo p in + ([]: operation list), ss \ No newline at end of file