From faafe7c3019fa137487120ee183b82c6259f16eb Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 17 Apr 2021 09:29:20 +0200 Subject: vhdl: handle object interface using an interface type. Fix #1726 --- src/vhdl/translate/trans-chap2.adb | 6 ++++++ src/vhdl/vhdl-sem_assocs.adb | 25 ++++++++++++++++++++++++- src/vhdl/vhdl-sem_inst.adb | 29 ++++++++++++++++++++++++++--- 3 files changed, 56 insertions(+), 4 deletions(-) (limited to 'src/vhdl') diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 373bb5699..44781852b 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -1563,6 +1563,12 @@ package body Trans.Chap2 is begin if Is_Valid (Bod) then Translate_Package_Body (Bod); + else + -- As an elaboration subprogram for the body is always + -- needed, generate it. + if not Is_Nested_Package (Inst) then + Elab_Package_Body (Inst, Null_Iir); + end if; end if; end; end if; diff --git a/src/vhdl/vhdl-sem_assocs.adb b/src/vhdl/vhdl-sem_assocs.adb index f90fd6e42..62e9d0ca7 100644 --- a/src/vhdl/vhdl-sem_assocs.adb +++ b/src/vhdl/vhdl-sem_assocs.adb @@ -1947,6 +1947,23 @@ package body Vhdl.Sem_Assocs is Formal_Type := Get_Type (Inter); end if; + -- If the formal type is an interface type of the same interface list, + -- use the associated type of the formal type to analyze the actual. + if Get_Kind (Formal_Type) = Iir_Kind_Interface_Type_Definition then + if Get_Parent (Get_Type_Declarator (Formal_Type)) = Get_Parent (Inter) + then + Formal_Type := Get_Associated_Type (Formal_Type); + if Formal_Type = Null_Iir then + -- Interface type are only allowed within generic map aspect, + -- which are analyzed in one step (so Finish is true). + pragma Assert (Finish); + Error_Msg_Sem (+Assoc, "expression associated before its type"); + Match := Not_Compatible; + return; + end if; + end if; + end if; + -- Extract conversion from actual. -- LRM08 6.5.7.1 Association lists Actual := Get_Actual (Assoc); @@ -2095,8 +2112,14 @@ package body Vhdl.Sem_Assocs is -- Use the type of the formal to analyze the actual. In -- particular, the formal may be constrained while the actual is -- not. + -- (but not when the formal_type is an interface type, as it + -- will bring nothing more and could have been substitued by + -- its associated type). Formal_Type := Get_Type (Formal); - if Out_Conv = Null_Iir and In_Conv = Null_Iir then + if (Out_Conv = Null_Iir and In_Conv = Null_Iir) + and then + Get_Kind (Formal_Type) /= Iir_Kind_Interface_Type_Definition + then Res_Type := Formal_Type; end if; end; diff --git a/src/vhdl/vhdl-sem_inst.adb b/src/vhdl/vhdl-sem_inst.adb index 07ce3f88d..b6b9f399f 100644 --- a/src/vhdl/vhdl-sem_inst.adb +++ b/src/vhdl/vhdl-sem_inst.adb @@ -965,7 +965,29 @@ package body Vhdl.Sem_Inst is when Iir_Kind_Association_Element_By_Expression | Iir_Kind_Association_Element_By_Individual | Iir_Kind_Association_Element_Open => - null; + -- If the type of the formal is an interface type also + -- associated by this map, change the type of the formal + -- to the associated type. + declare + Assoc_Formal : constant Iir := + Get_Association_Interface (Assoc, Inter); + Formal_Type : constant Iir := Get_Type (Assoc_Formal); + Formal_Orig : Iir; + begin + if Get_Kind (Formal_Type) + = Iir_Kind_Interface_Type_Definition + then + -- Type of the formal is an interface type. + -- Check if the interface type was declared in the same + -- interface list: must have the same parent. + Formal_Orig := Get_Origin (Assoc_Formal); + if Get_Parent (Get_Type_Declarator (Formal_Type)) + = Get_Parent (Formal_Orig) + then + Set_Type (Assoc_Formal, Get_Instance (Formal_Type)); + end if; + end if; + end; when Iir_Kind_Association_Element_Package => declare Sub_Inst : constant Iir := @@ -986,8 +1008,9 @@ package body Vhdl.Sem_Inst is -- Replace the incomplete interface type by the actual subtype -- indication. declare - Inter_Type_Def : constant Iir := - Get_Type (Get_Association_Interface (Assoc, Inter)); + Assoc_Inter : constant Iir := + Get_Association_Interface (Assoc, Inter); + Inter_Type_Def : constant Iir := Get_Type (Assoc_Inter); Actual_Type : constant Iir := Get_Actual_Type (Assoc); begin Set_Instance (Inter_Type_Def, Actual_Type); -- cgit v1.2.3