find_top_entity: add location to report errors. Fix #1254

8 files changed, 62 insertions, 45 deletions

diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb
index 38fa1c828..ec2356e4b 100644
--- a/src/ghdldrv/ghdllocal.adb
+++ b/src/ghdldrv/ghdllocal.adb
@@ -1218,7 +1218,8 @@ package body Ghdllocal is
          raise Option_Error;
       end if;
 
-      Top := Vhdl.Configuration.Find_Top_Entity (From);
+      Top := Vhdl.Configuration.Find_Top_Entity
+        (From, Libraries.Command_Line_Location);
 
       if Top = Null_Iir then
          Error ("no top entity found");
@@ -1318,7 +1319,8 @@ package body Ghdllocal is
                Set_Design_File_Source (File, Fe);
                Unit := Get_First_Design_Unit (File);
                while Unit /= Null_Iir loop
-                  Vhdl.Sem_Lib.Load_Parse_Design_Unit (Unit, Null_Iir);
+                  Vhdl.Sem_Lib.Load_Parse_Design_Unit
+                    (Unit, Command_Line_Location);
                   Extract_Library_Clauses (Unit);
                   Unit := Get_Chain (Unit);
                end loop;
@@ -1468,7 +1470,7 @@ package body Ghdllocal is
                Unit := Get_First_Design_Unit (File);
                while Unit /= Null_Iir loop
                   if not Get_Elab_Flag (Unit) then
-                     Add_Design_Unit (Unit, Null_Iir);
+                     Add_Design_Unit (Unit, Libraries.Command_Line_Location);
                   end if;
                   Unit := Get_Chain (Unit);
                end loop;
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
index ebe9366f8..58186948c 100644
--- a/src/ghdldrv/ghdlprint.adb
+++ b/src/ghdldrv/ghdlprint.adb
@@ -1379,7 +1379,7 @@ package body Ghdlprint is
               | Date_Disk =>
                raise Internal_Error;
             when Date_Parse =>
-               Vhdl.Sem_Lib.Load_Design_Unit (Unit, Unit);
+               Vhdl.Sem_Lib.Load_Design_Unit (Unit, Get_Location (Unit));
                if Errorout.Nbr_Errors /= 0 then
                   raise Compilation_Error;
                end if;
diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index 4166609bd..9fc3a2e98 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -253,7 +253,8 @@ package body Ghdlsynth is
       --  Elaborate
       if E_Opt = Args'Last then
          --  No unit.
-         Top := Vhdl.Configuration.Find_Top_Entity (Libraries.Work_Library);
+         Top := Vhdl.Configuration.Find_Top_Entity
+           (Libraries.Work_Library, Libraries.Command_Line_Location);
          if Top = Null_Node then
             Ghdlmain.Error ("no top unit found");
             return Null_Iir;
diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb
index f153251f6..230a2cc58 100644
--- a/src/vhdl/translate/trans-chap12.adb
+++ b/src/vhdl/translate/trans-chap12.adb
@@ -359,7 +359,7 @@ package body Trans.Chap12 is
 
       Decl : Iir;
    begin
-      Load_Design_Unit (Unit, Null_Iir);
+      Load_Design_Unit (Unit, Libraries.Command_Line_Location);
       Pkg := Get_Library_Unit (Unit);
       Reset_Identifier_Prefix;
       Lib := Get_Library (Get_Design_File (Get_Design_Unit (Pkg)));
@@ -433,7 +433,7 @@ package body Trans.Chap12 is
          Lib_Unit : Iir;
       begin
          --  Load the unit in memory to compute the dependence list.
-         Load_Design_Unit (Unit, Null_Iir);
+         Load_Design_Unit (Unit, Libraries.Command_Line_Location);
          Update_Node_Infos;
 
          Set_Elab_Flag (Unit, True);
diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb
index 3394ae5ba..5f50a16aa 100644
--- a/src/vhdl/vhdl-configuration.adb
+++ b/src/vhdl/vhdl-configuration.adb
@@ -41,8 +41,9 @@ package body Vhdl.Configuration is
    --  UNIT is a design unit of a configuration declaration.
    --  Fill the DESIGN_UNITS table with all design units required to build
    --  UNIT.
-   procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir)
+   procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Location_Type)
    is
+      Loc : constant Location_Type := Get_Location (Unit);
       List : Iir_List;
       It : List_Iterator;
       El : Iir;
@@ -75,13 +76,8 @@ package body Vhdl.Configuration is
 
       --  May be enabled to debug dependency construction.
       if False then
-         if From = Null_Iir then
-            Report_Msg (Msgid_Note, Elaboration, +Unit,
+         Report_Msg (Msgid_Note, Elaboration, +From,
                         "%n added", (1 => +Unit));
-         else
-            Report_Msg (Msgid_Note, Elaboration, +From,
-                        "%n added by %n", (+Unit, +From));
-         end if;
       end if;
 
       Lib_Unit := Get_Library_Unit (Unit);
@@ -123,12 +119,12 @@ package body Vhdl.Configuration is
          if El /= Null_Iir then
             Lib_Unit := Get_Library_Unit (El);
             if Flag_Build_File_Dependence then
-               Add_Design_Unit (El, Unit);
+               Add_Design_Unit (El, Loc);
             else
                case Get_Kind (Lib_Unit) is
                   when Iir_Kinds_Package_Declaration
                     | Iir_Kind_Context_Declaration =>
-                     Add_Design_Unit (El, Unit);
+                     Add_Design_Unit (El, Loc);
                   when others =>
                      null;
                end case;
@@ -154,7 +150,7 @@ package body Vhdl.Configuration is
             --  find all sub-configuration
             Load_Design_Unit (Unit, From);
             Lib_Unit := Get_Library_Unit (Unit);
-            Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit);
+            Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Loc);
             declare
                Blk : Iir_Block_Configuration;
                Prev_Configuration : Iir_Configuration_Declaration;
@@ -166,12 +162,12 @@ package body Vhdl.Configuration is
                Add_Design_Block_Configuration (Blk);
                Current_Configuration := Prev_Configuration;
                Arch := Strip_Denoting_Name (Get_Block_Specification (Blk));
-               Add_Design_Unit (Get_Design_Unit (Arch), Unit);
+               Add_Design_Unit (Get_Design_Unit (Arch), Loc);
             end;
          when Iir_Kind_Architecture_Body =>
             --  Add entity
             --  find all entity/architecture/configuration instantiation
-            Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit);
+            Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Loc);
             Add_Design_Concurrent_Stmts (Lib_Unit);
          when Iir_Kind_Entity_Declaration
            | Iir_Kind_Package_Body
@@ -224,7 +220,7 @@ package body Vhdl.Configuration is
             end if;
             if Bod /= Null_Iir then
                Set_Package (Get_Library_Unit (Bod), Lib_Unit);
-               Add_Design_Unit (Bod, Unit);
+               Add_Design_Unit (Bod, Loc);
             end if;
          end;
       end if;
@@ -288,6 +284,7 @@ package body Vhdl.Configuration is
    is
       use Libraries;
 
+      Loc : Location_Type;
       Entity : Iir;
       Arch_Name : Iir;
       Arch : Iir;
@@ -299,6 +296,7 @@ package body Vhdl.Configuration is
       if Aspect = Null_Iir then
          return;
       end if;
+      Loc := Get_Location (Aspect);
       case Get_Kind (Aspect) is
          when Iir_Kind_Entity_Aspect_Entity =>
             --  Add the entity.
@@ -308,7 +306,7 @@ package body Vhdl.Configuration is
                return;
             end if;
             Entity := Get_Design_Unit (Entity_Lib);
-            Add_Design_Unit (Entity, Aspect);
+            Add_Design_Unit (Entity, Loc);
 
             --  Extract and add the architecture.
             Arch_Name := Get_Architecture (Aspect);
@@ -361,16 +359,16 @@ package body Vhdl.Configuration is
                   --  Recursive instantiation.
                   return;
                else
-                  Add_Design_Unit (Config, Aspect);
+                  Add_Design_Unit (Config, Loc);
                end if;
             end if;
 
             --  Otherwise, simply the architecture.
-            Add_Design_Unit (Arch, Aspect);
+            Add_Design_Unit (Arch, Loc);
 
          when Iir_Kind_Entity_Aspect_Configuration =>
             Add_Design_Unit
-              (Get_Design_Unit (Get_Configuration (Aspect)), Aspect);
+              (Get_Design_Unit (Get_Configuration (Aspect)), Loc);
          when Iir_Kind_Entity_Aspect_Open =>
             null;
          when others =>
@@ -699,7 +697,7 @@ package body Vhdl.Configuration is
       Set_Configuration_Mark_Flag (Vhdl.Std_Package.Std_Standard_Unit, True);
       Set_Configuration_Done_Flag (Vhdl.Std_Package.Std_Standard_Unit, True);
 
-      Add_Design_Unit (Top, Null_Iir);
+      Add_Design_Unit (Top, Command_Line_Location);
       return Top;
    end Configure;
 
@@ -729,7 +727,7 @@ package body Vhdl.Configuration is
       end if;
       Set_Bound_Vunit_Chain (Vunit, Get_Bound_Vunit_Chain (Name));
       Set_Bound_Vunit_Chain (Name, Vunit);
-      Add_Design_Unit (Get_Design_Unit (Vunit), Vunit);
+      Add_Design_Unit (Get_Design_Unit (Vunit), Get_Location (Vunit));
    end Add_Verification_Unit;
 
    procedure Add_Verification_Units
@@ -855,7 +853,8 @@ package body Vhdl.Configuration is
    end Check_Entity_Declaration_Top;
 
    package Top is
-      procedure Mark_Instantiated_Units (Lib : Iir_Library_Declaration);
+      procedure Mark_Instantiated_Units
+        (Lib : Iir_Library_Declaration; Loc : Location_Type);
 
       Nbr_Top_Entities : Natural;
       First_Top_Entity : Iir;
@@ -866,6 +865,8 @@ package body Vhdl.Configuration is
    package body Top is
       use Nodes_Walk;
 
+      Loc_Err : Location_Type;
+
       --  Add entities to the name table (so that they easily could be found).
       function Add_Entity_Cb (Design : Iir) return Walk_Status
       is
@@ -881,9 +882,9 @@ package body Vhdl.Configuration is
          case Iir_Kinds_Library_Unit (Kind) is
             when Iir_Kind_Architecture_Body
               | Iir_Kind_Configuration_Declaration =>
-               Load_Design_Unit (Design, Null_Iir);
+               Load_Design_Unit (Design, Loc_Err);
             when Iir_Kind_Entity_Declaration =>
-               Load_Design_Unit (Design, Null_Iir);
+               Load_Design_Unit (Design, Loc_Err);
                Vhdl.Sem_Scopes.Add_Name (Get_Library_Unit (Design));
             when Iir_Kind_Package_Declaration
               | Iir_Kind_Package_Instantiation_Declaration
@@ -998,10 +999,14 @@ package body Vhdl.Configuration is
          return Walk_Continue;
       end Mark_Units_Cb;
 
-      procedure Mark_Instantiated_Units (Lib : Iir_Library_Declaration)
+      procedure Mark_Instantiated_Units
+        (Lib : Iir_Library_Declaration; Loc : Location_Type)
       is
          Status : Walk_Status;
       begin
+         pragma Assert (Loc /= No_Location);
+         Loc_Err := Loc;
+
          --  Name table is used to map names to entities.
          Vhdl.Sem_Scopes.Push_Interpretations;
          Vhdl.Sem_Scopes.Open_Declarative_Region;
@@ -1054,10 +1059,10 @@ package body Vhdl.Configuration is
 
    end Top;
 
-   function Find_Top_Entity (From : Iir) return Iir is
+   function Find_Top_Entity (From : Iir; Loc : Location_Type) return Iir is
    begin
       --  FROM is a library or a design file.
-      Top.Mark_Instantiated_Units (From);
+      Top.Mark_Instantiated_Units (From, Loc);
       Top.Find_First_Top_Entity (From);
 
       if Top.Nbr_Top_Entities = 1 then
diff --git a/src/vhdl/vhdl-configuration.ads b/src/vhdl/vhdl-configuration.ads
index f31750a1d..3628f51d6 100644
--- a/src/vhdl/vhdl-configuration.ads
+++ b/src/vhdl/vhdl-configuration.ads
@@ -39,7 +39,7 @@ package Vhdl.Configuration is
      return Iir;
 
    --  Add design unit UNIT (with its dependences) in the design_units table.
-   procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir);
+   procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Location_Type);
 
    --  Add all vunits that are bound to any configured entity architecture.
    procedure Add_Verification_Units;
@@ -60,7 +60,8 @@ package Vhdl.Configuration is
    --  Use heuritics to find the top entity in FROM (either a library or
    --  a design file): mark all instantiated units and return the unmarked
    --  one if there is only one.
-   function Find_Top_Entity (From : Iir) return Iir;
+   --  LOC is used to report errors.
+   function Find_Top_Entity (From : Iir; Loc : Location_Type) return Iir;
 
    --  Add an override for generic ID.
    procedure Add_Generic_Override (Id : Name_Id; Value : String);
diff --git a/src/vhdl/vhdl-sem_lib.adb b/src/vhdl/vhdl-sem_lib.adb
index 2197c6b5e..7144d7725 100644
--- a/src/vhdl/vhdl-sem_lib.adb
+++ b/src/vhdl/vhdl-sem_lib.adb
@@ -175,7 +175,8 @@ package body Vhdl.Sem_Lib is
       Set_Dependence_List (Design, Null_Iir_List);
    end Free_Dependence_List;
 
-   procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir)
+   procedure Load_Parse_Design_Unit
+     (Design_Unit: Iir_Design_Unit; Loc : Location_Type)
    is
       use Vhdl.Scanner;
       Design_File : constant Iir_Design_File := Get_Design_File (Design_Unit);
@@ -262,19 +263,16 @@ package body Vhdl.Sem_Lib is
       Free_Iir (Res);
    end Load_Parse_Design_Unit;
 
-   procedure Error_Obsolete (Loc : Iir; Msg : String; Args : Earg_Arr) is
+   procedure Error_Obsolete
+     (Loc : Location_Type; Msg : String; Args : Earg_Arr) is
    begin
       if not Flags.Flag_Elaborate_With_Outdated then
-         if Loc = Null_Iir then
-            Error_Msg_Sem (Command_Line_Location, Msg, Args);
-         else
-            Error_Msg_Sem (+Loc, Msg, Args);
-         end if;
+         Error_Msg_Sem (Loc, Msg, Args);
       end if;
    end Error_Obsolete;
 
    --  Check if one of its dependency makes this unit obsolete.
-   function Check_Obsolete_Dependence (Design_Unit : Iir; Loc : Iir)
+   function Check_Obsolete_Dependence (Design_Unit : Iir; Loc : Location_Type)
                                       return Boolean
    is
       List : constant Iir_List := Get_Dependence_List (Design_Unit);
@@ -305,7 +303,8 @@ package body Vhdl.Sem_Lib is
       return False;
    end Check_Obsolete_Dependence;
 
-   procedure Explain_Obsolete (Design_Unit : Iir_Design_Unit; Loc : Iir)
+   procedure Explain_Obsolete
+     (Design_Unit : Iir_Design_Unit; Loc : Location_Type)
    is
       List : Iir_List;
       It : List_Iterator;
@@ -333,7 +332,8 @@ package body Vhdl.Sem_Lib is
    end Explain_Obsolete;
 
    -- 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 : Location_Type)
    is
       Prev_Nbr_Errors : Natural;
       Warnings : Warnings_Setting;
@@ -420,6 +420,11 @@ package body Vhdl.Sem_Lib is
       end case;
    end Load_Design_Unit;
 
+   procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) is
+   begin
+      Load_Design_Unit (Design_Unit, Get_Location (Loc));
+   end Load_Design_Unit;
+
    function Load_Primary_Unit
      (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir)
       return Iir_Design_Unit
diff --git a/src/vhdl/vhdl-sem_lib.ads b/src/vhdl/vhdl-sem_lib.ads
index 97803d8c3..0469b4ff5 100644
--- a/src/vhdl/vhdl-sem_lib.ads
+++ b/src/vhdl/vhdl-sem_lib.ads
@@ -30,13 +30,16 @@ package Vhdl.Sem_Lib is
    --  Load, parse, analyze, back-end a design_unit if necessary.
    --  Check Design_Unit is not obsolete.
    --  LOC is the location where the design unit was needed, in case of error.
+   procedure Load_Design_Unit
+     (Design_Unit: Iir_Design_Unit; Loc : Location_Type);
    procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir);
 
    --  Load and parse DESIGN_UNIT.
    --  Contrary to Load_Design_Unit, the design_unit is not analyzed.
    --  Also, the design_unit must not have been already loaded.
    --  Used almost only by Load_Design_Unit.
-   procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir);
+   procedure Load_Parse_Design_Unit
+     (Design_Unit: Iir_Design_Unit; Loc : Location_Type);
 
       -- Load an already analyzed primary unit NAME from library LIBRARY
    -- and compile it.