diff options
| -rw-r--r-- | src/libraries.adb | 7 | ||||
| -rw-r--r-- | src/vhdl/iirs.ads | 9 | ||||
| -rw-r--r-- | src/vhdl/sem.adb | 52 |
3 files changed, 38 insertions, 30 deletions
diff --git a/src/libraries.adb b/src/libraries.adb index 64471f6b6..02af0647d 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -1787,10 +1787,15 @@ package body Libraries is end Load_Parse_Design_Unit; -- Load, parse, analyze, back-end a design_unit if necessary. - procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) + procedure Load_Design_Unit (Design_Unit : Iir_Design_Unit; Loc : Iir) is Warnings : Warnings_Setting; begin + if Get_Date (Design_Unit) = Date_Replacing then + Error_Msg_Sem (+Loc, "circular reference of %n", +Design_Unit); + return; + end if; + if Get_Date_State (Design_Unit) = Date_Disk then Load_Parse_Design_Unit (Design_Unit, Loc); end if; diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 1ff1934ea..5501894a1 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -5479,15 +5479,14 @@ package Iirs is type Date_Type is new Nat32; -- The unit is obsoleted (ie replaced) by a more recently analyzed design - -- unit.another design unit. + -- unit. -- If another design unit depends (directly or not) on an obseleted design -- unit, it is also obsolete, and cannot be defined. Date_Obsolete : constant Date_Type := 0; + -- A unit with the same name (could also be the same unit) is being + -- analyzed. Used to detect circular dependencies. + Date_Replacing : constant Date_Type := 1; -- The unit was not analyzed. - Date_Not_Analyzed : constant Date_Type := 1; - -- The unit has been analyzed but it has bad dependences. - Date_Bad_Analyze : constant Date_Type := 2; - -- The unit has been parsed but not analyzed. Date_Parsed : constant Date_Type := 4; -- The unit is being analyzed. Date_Analyzing : constant Date_Type := 5; diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 0893120e2..c8f0822e2 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -3172,10 +3172,12 @@ package body Sem is end Get_Current_Design_Unit; -- LRM 11.1 Design units. - procedure Semantic (Design_Unit: Iir_Design_Unit) + procedure Semantic (Design_Unit : Iir_Design_Unit) is - El: Iir; - Old_Design_Unit: Iir_Design_Unit; + Library_Unit : constant Iir := Get_Library_Unit (Design_Unit); + Library : constant Iir := Get_Library (Get_Design_File (Design_Unit)); + Prev_Unit : Iir; + Old_Design_Unit : Iir_Design_Unit; Implicit : Implicit_Signal_Declaration_Type; begin -- Sanity check: can analyze either previously analyzed unit or just @@ -3193,7 +3195,17 @@ package body Sem is raise Internal_Error; end case; - -- Save and set current_design_unit. + -- If there is already a unit with the same name, mark it as being + -- replaced. + if Get_Kind (Library_Unit) in Iir_Kinds_Primary_Unit then + Prev_Unit := Libraries.Find_Primary_Unit + (Library, Get_Identifier (Library_Unit)); + if Is_Valid (Prev_Unit) and then Prev_Unit /= Design_Unit then + Set_Date (Prev_Unit, Date_Replacing); + end if; + end if; + + -- Save and set current_design_unit. Old_Design_Unit := Current_Design_Unit; Current_Design_Unit := Design_Unit; Push_Signals_Declarative_Part (Implicit, Null_Iir); @@ -3214,45 +3226,37 @@ package body Sem is -- due to reasons given by LCS 3 (VHDL Issue # 1028). Open_Declarative_Region; - -- Set_Dependence_List (Design_Unit, --- Create_Iir (Iir_Kind_Design_Unit_List)); - -- LRM 11.2 -- Every design unit is assumed to contain the following implicit -- context items as part of its context clause: -- library STD, WORK; use STD.STANDARD.all; Sem_Scopes.Add_Name (Libraries.Std_Library, Std_Names.Name_Std, False); - Sem_Scopes.Add_Name (Get_Library (Get_Design_File (Design_Unit)), - Std_Names.Name_Work, - False); + Sem_Scopes.Add_Name (Library, Std_Names.Name_Work, False); Sem_Scopes.Use_All_Names (Standard_Package); if Get_Dependence_List (Design_Unit) = Null_Iir_List then Set_Dependence_List (Design_Unit, Create_Iir_List); end if; Add_Dependence (Std_Standard_Unit); - -- Semantic on context clauses. + -- Analyze context clauses. Sem_Context_Clauses (Design_Unit); - -- semantic on the library unit. - El := Get_Library_Unit (Design_Unit); - case Get_Kind (El) is + -- Analyze the library unit. + case Iir_Kinds_Library_Unit (Get_Kind (Library_Unit)) is when Iir_Kind_Entity_Declaration => - Sem_Entity_Declaration (El); + Sem_Entity_Declaration (Library_Unit); when Iir_Kind_Architecture_Body => - Sem_Architecture_Body (El); + Sem_Architecture_Body (Library_Unit); when Iir_Kind_Package_Declaration => - Sem_Package_Declaration (El); + Sem_Package_Declaration (Library_Unit); when Iir_Kind_Package_Body => - Sem_Package_Body (El); + Sem_Package_Body (Library_Unit); when Iir_Kind_Configuration_Declaration => - Sem_Configuration_Declaration (El); + Sem_Configuration_Declaration (Library_Unit); when Iir_Kind_Package_Instantiation_Declaration => - Sem_Package_Instantiation_Declaration (El); + Sem_Package_Instantiation_Declaration (Library_Unit); when Iir_Kind_Context_Declaration => - Sem_Context_Declaration (El); - when others => - Error_Kind ("semantic", El); + Sem_Context_Declaration (Library_Unit); end case; Close_Declarative_Region; @@ -3267,7 +3271,7 @@ package body Sem is Sem_Analysis_Checks_List (Design_Unit, False); end if; - -- Restore current_design_unit. + -- Restore current_design_unit. Current_Design_Unit := Old_Design_Unit; Pop_Signals_Declarative_Part (Implicit); end Semantic; |