Add -Wothers warning.

4 files changed, 36 insertions, 22 deletions

diff --git a/src/options.adb b/src/options.adb
index 43f68bbb5..f200d1c71 100644
--- a/src/options.adb
+++ b/src/options.adb
@@ -112,7 +112,7 @@ package body Options is
       elsif Opt'Length > 7 and then Opt (1 .. 7) = "--warn-" then
          return Option_Warning (Opt (8 .. Opt'Last), True);
       elsif Opt'Length > 5 and then Opt (1 .. 5) = "-Wno-" then
-         --  Handle -Wno before -W!
+         --  Handle -Wno-xxx before -Wxxx
          return Option_Warning (Opt (6 .. Opt'Last), False);
       elsif Opt'Length > 2 and then Opt (1 .. 2) = "-W" then
          return Option_Warning (Opt (3 .. Opt'Last), True);
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index f512b0624..595c5c094 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -110,6 +110,9 @@ package Errorout is
       --  FIXME: currently only subprograms are handled.
       Warnid_Unused,
 
+      --  Others choice is not needed, all values are already covered.
+      Warnid_Others,
+
       --  Violation of pure rules.
       Warnid_Pure,
 
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 605530067..11b4e544c 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -2519,8 +2519,7 @@ package body Sem_Expr is
          --  of index type BT at location LOC.
          procedure Error_No_Choice (Bt : Iir;
                                     L, H : Iir_Int64;
-                                    Loc : Location_Type)
-         is
+                                    Loc : Location_Type) is
          begin
             if L = H then
                Error_Msg_Sem (+Loc, "no choice for " & Disp_Discrete (Bt, L));
@@ -2536,6 +2535,8 @@ package body Sem_Expr is
          Pos : Iir_Int64;
          Pos_Max : Iir_Int64;
          E_Pos : Iir_Int64;
+         Choice : Iir;
+         Need_Others : Boolean;
 
          Bt : constant Iir := Get_Base_Type (Choice_Type);
       begin
@@ -2561,40 +2562,53 @@ package body Sem_Expr is
             Free (Info.Arr);
             return;
          end if;
+         Need_Others := False;
          for I in Info.Arr'Range loop
-            E_Pos := Eval_Pos (Get_Assoc_Low (Info.Arr (I)));
+            Choice := Info.Arr (I);
+            E_Pos := Eval_Pos (Get_Assoc_Low (Choice));
             if E_Pos > Pos_Max then
                --  Choice out of bound, already handled.
-               Error_No_Choice
-                 (Bt, Pos, Pos_Max, Get_Location (Info.Arr (I)));
+               Error_No_Choice (Bt, Pos, Pos_Max, Get_Location (Choice));
                --  Avoid other errors.
                Pos := Pos_Max + 1;
                exit;
             end if;
             if Pos < E_Pos then
+               Need_Others := True;
                if Info.Others_Choice = Null_Iir then
-                  Error_No_Choice
-                    (Bt, Pos, E_Pos - 1, Get_Location (Info.Arr (I)));
+                  Error_No_Choice (Bt, Pos, E_Pos - 1, Get_Location (Choice));
                end if;
             elsif Pos > E_Pos then
+               Need_Others := True;
                if Pos = E_Pos + 1 then
                   Error_Msg_Sem
-                    (+Info.Arr (I),
+                    (+Choice,
                      "duplicate choice for " & Disp_Discrete (Bt, E_Pos));
                else
                   Error_Msg_Sem
-                    (+Info.Arr (I), "duplicate choices for "
+                    (+Choice, "duplicate choices for "
                        & Disp_Discrete (Bt, E_Pos)
                        & " to " & Disp_Discrete (Bt, Pos));
                end if;
             end if;
-            Pos := Eval_Pos (Get_Assoc_High (Info.Arr (I))) + 1;
+
+            if Get_Kind (Choice) = Iir_Kind_Choice_By_Range then
+               Pos := Eval_Pos (Get_Assoc_High (Choice)) + 1;
+            else
+               Pos := E_Pos + 1;
+            end if;
          end loop;
          if Pos /= Pos_Max + 1 then
+            Need_Others := True;
             if Info.Others_Choice = Null_Iir then
                Error_No_Choice (Bt, Pos, Pos_Max, Loc);
             end if;
          end if;
+
+         if not Need_Others and then Info.Others_Choice /= Null_Iir then
+            Warning_Msg_Sem (Warnid_Others, +Info.Others_Choice,
+                             "redundant 'others' choices");
+         end if;
       end;
 
       --  LRM93 7.3.2.2 Array aggregates
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 582b3be68..67ef4bed3 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -2931,7 +2931,9 @@ package body Trans.Chap7 is
 
       --  Assign EXPR to current position (defined by index VAR_INDEX), and
       --  update VAR_INDEX.  Handles sub-aggregates.
-      procedure Do_Assign (Expr : Iir) is
+      procedure Do_Assign (Assoc : Iir)
+      is
+         Expr : constant Iir := Get_Associated_Expr (Assoc);
       begin
          if Final then
             Translate_Assign (Chap3.Index_Base (Base_Ptr, Aggr_Type,
@@ -2960,7 +2962,7 @@ package body Trans.Chap7 is
                return;
             end if;
             exit when Get_Kind (El) /= Iir_Kind_Choice_By_None;
-            Do_Assign (Get_Associated_Expr (El));
+            Do_Assign (El);
             P := P + 1;
             El := Get_Chain (El);
          end loop;
@@ -2997,7 +2999,7 @@ package body Trans.Chap7 is
                                New_Lit (Ghdl_Index_0),
                                Ghdl_Bool_Type));
 
-            Do_Assign (Get_Associated_Expr (El));
+            Do_Assign (El);
             Dec_Var (Var_Len);
             Finish_Loop_Stmt (Label);
             Close_Temp;
@@ -3018,7 +3020,7 @@ package body Trans.Chap7 is
                   --  Handled by positional.
                   raise Internal_Error;
                when Iir_Kind_Choice_By_Expression =>
-                  Do_Assign (Get_Associated_Expr (El));
+                  Do_Assign (El);
                   return;
                when Iir_Kind_Choice_By_Range =>
                   declare
@@ -3038,7 +3040,7 @@ package body Trans.Chap7 is
                                                     New_Obj_Value (Var_I),
                                                     New_Obj_Value (Var_Length),
                                                     Ghdl_Bool_Type));
-                     Do_Assign (Get_Associated_Expr (El));
+                     Do_Assign (El);
                      Inc_Var (Var_I);
                      Finish_Loop_Stmt (Label);
                      Close_Temp;
@@ -3059,7 +3061,6 @@ package body Trans.Chap7 is
             If_Blk     : O_If_Block;
             Case_Blk   : O_Case_Block;
             Label      : O_Snode;
-            El_Assoc   : Iir;
             Len_Tmp    : O_Enode;
          begin
             Open_Temp;
@@ -3089,15 +3090,11 @@ package body Trans.Chap7 is
 
             --  convert aggr into a case statement.
             Start_Case_Stmt (Case_Blk, New_Obj_Value (Var_Pos));
-            El_Assoc := Null_Iir;
             while El /= Null_Iir loop
                Start_Choice (Case_Blk);
                Chap8.Translate_Case_Choice (El, Range_Type, Case_Blk);
-               if Get_Associated_Expr (El) /= Null_Iir then
-                  El_Assoc := Get_Associated_Expr (El);
-               end if;
                Finish_Choice (Case_Blk);
-               Do_Assign (El_Assoc);
+               Do_Assign (El);
                El := Get_Chain (El);
             end loop;
             Finish_Case_Stmt (Case_Blk);