From a08adbd085b2f3d69f657cffb71ca7d206944ecd Mon Sep 17 00:00:00 2001
From: Lesenechal Remi <lesenechal.remi@gmail.com>
Date: Wed, 26 Feb 2020 18:54:16 +0100
Subject: [PATCH] typer: checks for constructor redundancy

---
 src/bin/expect_tests/contract_tests.ml        | 16 ++++++++++++++-
 src/passes/4-typer-old/typer.ml               | 12 +++++++++++
 .../negative/redundant_constructors.mligo     | 20 +++++++++++++++++++
 3 files changed, 47 insertions(+), 1 deletion(-)
 create mode 100644 src/test/contracts/negative/redundant_constructors.mligo

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