From aefc9a8fdfffab2fb32194263e7f4811422b4a56 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 23 Sep 2017 08:38:58 +0200 Subject: sem_assoc: fix cleanup, emit errors when not soft. --- src/vhdl/sem_assocs.adb | 104 ++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 84 insertions(+), 20 deletions(-) diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb index c58e0b0a8..70a6af9c4 100644 --- a/src/vhdl/sem_assocs.adb +++ b/src/vhdl/sem_assocs.adb @@ -2114,6 +2114,30 @@ package body Sem_Assocs is Loc : Iir; Match : out Compatibility_Level) is + First_Named_Assoc : Iir; + Last_Named_Assoc : Iir; + + procedure Cleanup_Formals + is + Assoc : Iir; + Formal : Iir; + begin + if Finish or First_Named_Assoc = Null_Iir then + return; + end if; + Assoc := First_Named_Assoc; + while Assoc /= Null_Iir loop + Formal := Get_Formal (Assoc); + -- User may have used by position assoc after named + -- assocs. + if Is_Valid (Formal) then + Sem_Name_Clean (Formal); + end if; + exit when Assoc = Last_Named_Assoc; + Assoc := Get_Chain (Assoc); + end loop; + end Cleanup_Formals; + Assoc : Iir; Inter : Iir; @@ -2128,11 +2152,11 @@ package body Sem_Assocs is Pos : Integer; Formal : Iir; - First_Named_Assoc : Iir; Formal_Name : Iir; Formal_Conv : Iir; begin Match := Fully_Compatible; + First_Named_Assoc := Null_Iir; Has_Individual := False; -- Loop on every assoc element, try to match it. @@ -2215,6 +2239,9 @@ package body Sem_Assocs is exit; end if; + -- Last assoc to be cleaned up. + Last_Named_Assoc := Assoc; + if Finish then Sem_Name (Formal); else @@ -2247,6 +2274,10 @@ package body Sem_Assocs is or else Get_Formal (Call_Assoc) /= Null_Iir or else Get_Actual_Conversion (Call_Assoc) /= Null_Iir then + if Finish then + Error_Msg_Sem + (+Assoc, "ill-formed formal conversion"); + end if; Match := Not_Compatible; exit; end if; @@ -2270,18 +2301,56 @@ package body Sem_Assocs is | Iir_Kind_Indexed_Name => Inter := Get_Base_Name (Formal_Name); Set_Whole_Association_Flag (Assoc, False); - when Iir_Kind_Simple_Name => + when Iir_Kind_Simple_Name + | Iir_Kind_Operator_Symbol => Inter := Get_Named_Entity (Formal_Name); Formal_Name := Inter; Set_Whole_Association_Flag (Assoc, True); when others => -- Error + if Finish then + Error_Msg_Sem (+Assoc, "formal is not a name"); + end if; Match := Not_Compatible; exit; end case; + + -- Simplify overload list (for interface subprogram). + -- FIXME: Interface must hide previous subprogram declarations, so + -- there should be no need to filter. + if Is_Overload_List (Inter) then + declare + List : constant Iir_List := Get_Overload_List (Inter); + Filtered_Inter : Iir; + El : Iir; + begin + Filtered_Inter := Null_Iir; + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + if Get_Kind (El) in Iir_Kinds_Interface_Declaration + and then Get_Parent (El) = Get_Parent (Interface_Chain) + then + Add_Result (Filtered_Inter, El); + end if; + end loop; + Free_Overload_List (Inter); + Inter := Filtered_Inter; + if Is_Overload_List (Inter) then + if Finish then + Error_Msg_Sem (+Assoc, "ambiguous formal name"); + end if; + Match := Not_Compatible; + exit; + end if; + end; + end if; if Get_Kind (Inter) not in Iir_Kinds_Interface_Declaration or else Get_Parent (Inter) /= Get_Parent (Interface_Chain) then + if Finish then + Error_Msg_Sem (+Assoc, "formal is not an interface name"); + end if; Match := Not_Compatible; exit; end if; @@ -2296,6 +2365,12 @@ package body Sem_Assocs is (Get_Kind (Inter) not in Iir_Kinds_Interface_Object_Declaration or else Get_Mode (Inter) = Iir_In_Mode) then + if Finish then + Error_Msg_Sem + (+Assoc, + "formal conversion allowed only for inerface object", + +Formal_Conv); + end if; Match := Not_Compatible; exit; end if; @@ -2312,6 +2387,10 @@ package body Sem_Assocs is Pos := Pos + 1; end loop; if Inter1 = Null_Iir then + if Finish then + Error_Msg_Sem + (+Assoc, "no corresponding interface for %i", +Inter); + end if; Match := Not_Compatible; exit; end if; @@ -2401,24 +2480,7 @@ package body Sem_Assocs is Sem_Scopes.Close_Declarative_Region; if Match = Not_Compatible then - -- Clean-up. - if not Finish then - declare - Last_Assoc : constant Iir := Assoc; - begin - Assoc := First_Named_Assoc; - while Assoc /= Null_Iir loop - Formal := Get_Formal (Assoc); - -- User may have used by position assoc after named - -- assocs. - if Is_Valid (Formal) then - Sem_Name_Clean (Formal); - end if; - exit when Assoc = Last_Assoc; - Assoc := Get_Chain (Assoc); - end loop; - end; - end if; + Cleanup_Formals; return; end if; end if; @@ -2471,6 +2533,7 @@ package body Sem_Assocs is if Finish then Error_Msg_Sem (+Loc, "no actual for %n", +Inter); end if; + Cleanup_Formals; Match := Not_Compatible; return; when Missing_Port => @@ -2512,6 +2575,7 @@ package body Sem_Assocs is | Iir_Kind_Interface_Function_Declaration | Iir_Kind_Interface_Procedure_Declaration => Error_Msg_Sem (+Loc, "%n must be associated", +Inter); + Cleanup_Formals; Match := Not_Compatible; when others => Error_Kind ("sem_association_chain", Inter); -- cgit v1.2.3