Overload resolution: reject invalid indexed names.

1 files changed, 33 insertions, 3 deletions

diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 748ebf383..f297f8617 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -461,7 +461,7 @@ package body Sem_Names is
    --  PARENT is used if an implicit dereference node is created, to copy
    --  location from.
    function Insert_Implicit_Dereference (Prefix : Iir; Parent : Iir)
-     return Iir
+                                        return Iir
    is
       Prefix_Type : Iir;
       Res : Iir_Implicit_Dereference;
@@ -645,8 +645,7 @@ package body Sem_Names is
       Set_Base_Name (Expr, Get_Base_Name (Prefix));
    end Finish_Sem_Indexed_Name;
 
-   procedure Finish_Sem_Dereference (Res : Iir)
-   is
+   procedure Finish_Sem_Dereference (Res : Iir) is
    begin
       Set_Base_Name (Res, Res);
       Check_Read (Get_Prefix (Res));
@@ -2240,6 +2239,37 @@ package body Sem_Names is
             return Null_Iir;
          end if;
 
+         --  For indexed names, discard type incompatibilities between indexes
+         --  and array type indexes.
+         --  The FINISH = True case will be handled by Finish_Sem_Indexed_Name.
+         if Slice_Index_Kind = Iir_Kind_Indexed_Name and then not Finish then
+            declare
+               Type_Index_List : constant Iir_List :=
+                 Get_Index_Subtype_List (Base_Type);
+               Type_Index : Iir;
+               Assoc : Iir;
+            begin
+               Assoc := Assoc_Chain;
+               for I in Natural loop
+                  --  Assoc and Type_Index_List have the same length as this
+                  --  was checked just above.
+                  exit when Assoc = Null_Iir;
+                  if Get_Kind (Assoc)
+                    /= Iir_Kind_Association_Element_By_Expression
+                  then
+                     return Null_Iir;
+                  end if;
+                  Type_Index := Get_Index_Type (Type_Index_List, I);
+                  if Is_Expr_Compatible (Type_Index, Get_Actual (Assoc))
+                    = Not_Compatible
+                  then
+                     return Null_Iir;
+                  end if;
+                  Assoc := Get_Chain (Assoc);
+               end loop;
+            end;
+         end if;
+
          if not Maybe_Function_Call (Sub_Name) then
             if Finish then
                Error_Msg_Sem ("missing parameters for function call", Name);