diff options
| -rw-r--r-- | src/vhdl/sem_names.adb | 36 |
1 files changed, 33 insertions, 3 deletions
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index 748ebf3..f297f86 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); |