ghdldrv: handle generic overrides on foreign units

4 files changed, 75 insertions, 50 deletions

diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb
index 4e0b0b05b..722c1a26f 100644
--- a/src/ghdldrv/ghdllocal.adb
+++ b/src/ghdldrv/ghdllocal.adb
@@ -86,7 +86,6 @@ package body Ghdllocal is
       pragma Assert (Opt'First = 1);
       pragma Assert (Opt'Last >= 5);
       Eq_Pos : Natural;
-      Id : Name_Id;
    begin
       Eq_Pos := 0;
       for I in 3 .. Opt'Last loop
@@ -106,21 +105,9 @@ package body Ghdllocal is
          return Option_Err;
       end if;
 
-      declare
-         Res : String (1 .. Eq_Pos - 3) := Opt (3 .. Eq_Pos - 1);
-         Err : Boolean;
-      begin
-         Vhdl.Scanner.Convert_Identifier (Res, Err);
-         if Err then
-            Error_Msg_Option
-              ("incorrect generic name in generic override option");
-            return Option_Err;
-         end if;
-         Id := Name_Table.Get_Identifier (Res);
-      end;
-
       Vhdl.Configuration.Add_Generic_Override
-        (Id, Opt (Eq_Pos + 1 .. Opt'Last));
+        (Opt (3 .. Eq_Pos - 1), Opt (Eq_Pos + 1 .. Opt'Last));
+
       return Option_Ok;
    end Decode_Generic_Override_Option;
 
diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index cfc5f281b..ced5b71c9 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -378,20 +378,25 @@ package body Ghdlsynth is
          Foreign_Resolve_Instances.all;
       end if;
 
-      if Get_Kind (Get_Library_Unit (Config)) /= Iir_Kind_Foreign_Module then
-         --  Check (and possibly abandon) if entity can be at the top of the
-         --  hierarchy.
-         declare
-            Entity : constant Iir :=
-              Vhdl.Utils.Get_Entity_From_Configuration (Config);
-         begin
-            Vhdl.Configuration.Apply_Generic_Override (Entity);
-            Vhdl.Configuration.Check_Entity_Declaration_Top (Entity, False);
-            if Nbr_Errors > 0 then
-               return Null_Iir;
-            end if;
-         end;
-      end if;
+      --  Check (and possibly abandon) if entity can be at the top of the
+      --  hierarchy.
+      declare
+         Config_Unit : constant Iir := Get_Library_Unit (Config);
+         Top : Iir;
+      begin
+         if Get_Kind (Config_Unit) = Iir_Kind_Foreign_Module then
+            Top := Config_Unit;
+            Vhdl.Configuration.Apply_Generic_Override (Top);
+            --  No Check_Entity_Declaration (yet).
+         else
+            Top := Vhdl.Utils.Get_Entity_From_Configuration (Config);
+            Vhdl.Configuration.Apply_Generic_Override (Top);
+            Vhdl.Configuration.Check_Entity_Declaration_Top (Top, False);
+         end if;
+         if Nbr_Errors > 0 then
+            return Null_Iir;
+         end if;
+      end;
       return Config;
    end Ghdl_Synth_Configure;
 
diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb
index aeb737028..64a615bfb 100644
--- a/src/vhdl/vhdl-configuration.adb
+++ b/src/vhdl/vhdl-configuration.adb
@@ -27,6 +27,7 @@ with Vhdl.Sem_Scopes;
 with Vhdl.Sem_Lib; use Vhdl.Sem_Lib;
 with Vhdl.Canon;
 with Vhdl.Evaluation;
+with Vhdl.Scanner;
 
 package body Vhdl.Configuration is
    procedure Add_Design_Concurrent_Stmts (Parent : Iir);
@@ -1167,7 +1168,7 @@ package body Vhdl.Configuration is
    end Find_Top_Entity;
 
    type Override_Entry is record
-      Gen : Name_Id;
+      Gen : String_Acc;
       Value : String_Acc;
    end record;
 
@@ -1177,9 +1178,9 @@ package body Vhdl.Configuration is
       Table_Low_Bound => 1,
       Table_Initial => 16);
 
-   procedure Add_Generic_Override (Id : Name_Id; Value : String) is
+   procedure Add_Generic_Override (Name : String; Value : String) is
    begin
-      Override_Table.Append (Override_Entry'(Gen => Id,
+      Override_Table.Append (Override_Entry'(Gen => new String'(Name),
                                              Value => new String'(Value)));
    end Add_Generic_Override;
 
@@ -1325,29 +1326,57 @@ package body Vhdl.Configuration is
 
    procedure Apply_Generic_Override (Ent : Iir)
    is
-      Inter_Chain : constant Iir := Get_Generic_Chain (Ent);
-      Inter : Iir;
    begin
       for I in Override_Table.First .. Override_Table.Last loop
          declare
             Over : constant Override_Entry := Override_Table.Table (I);
          begin
-            Inter := Inter_Chain;
-            while Inter /= Null_Iir loop
-               exit when Get_Identifier (Inter) = Over.Gen;
-               Inter := Get_Chain (Inter);
-            end loop;
+            case Get_Kind (Ent) is
+               when Iir_Kind_Entity_Declaration =>
+                  declare
+                     Inter_Chain : constant Iir := Get_Generic_Chain (Ent);
+                     Gen_Name : String := Over.Gen.all;
+                     Gen_Id : Name_Id;
+                     Inter : Iir;
+                     Err : Boolean;
+                  begin
+                     Vhdl.Scanner.Convert_Identifier (Gen_Name, Err);
+                     if Err then
+                        Error_Msg_Option
+                          ("incorrect name in generic override option");
+                        Gen_Id := Null_Identifier;
+                     else
+                        Gen_Id := Name_Table.Get_Identifier (Gen_Name);
 
-            if Inter = Null_Iir then
-               Error_Msg_Elab ("no generic %i for -g", +Over.Gen);
-            elsif Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration
-            then
-               Error_Msg_Elab
-                 ("generic %n cannot be overriden (not a constant)",
-                  +Over.Gen);
-            else
-               Override_Generic (Inter, Over.Value);
-            end if;
+                        Inter := Inter_Chain;
+                        while Inter /= Null_Iir loop
+                           exit when Get_Identifier (Inter) = Gen_Id;
+                           Inter := Get_Chain (Inter);
+                        end loop;
+                     end if;
+
+                     if Gen_Id = Null_Identifier then
+                        --  Skip it
+                        null;
+                     elsif Inter = Null_Iir then
+                        Error_Msg_Elab ("no generic %i for -g", +Gen_Id);
+                     elsif (Get_Kind (Inter)
+                              /= Iir_Kind_Interface_Constant_Declaration)
+                     then
+                        --  Could be a generic package, a generic type...
+                        Error_Msg_Elab
+                          ("generic %n cannot be overriden (not a constant)",
+                           +Gen_Id);
+                     else
+                        Override_Generic (Inter, Over.Value);
+                     end if;
+                  end;
+               when Iir_Kind_Foreign_Module =>
+                  Apply_Foreign_Override
+                    (Get_Foreign_Node (Ent), Over.Gen.all, Over.Value.all);
+               when others =>
+                  raise Internal_Error;
+            end case;
          end;
       end loop;
    end Apply_Generic_Override;
diff --git a/src/vhdl/vhdl-configuration.ads b/src/vhdl/vhdl-configuration.ads
index d272d23e9..dfd59c516 100644
--- a/src/vhdl/vhdl-configuration.ads
+++ b/src/vhdl/vhdl-configuration.ads
@@ -69,8 +69,12 @@ package Vhdl.Configuration is
    type Mark_Instantiated_Units_Access is access procedure (N : Int32);
    Mark_Foreign_Module : Mark_Instantiated_Units_Access;
 
+   type Apply_Foreign_Override_Access is access procedure
+     (Top : Int32; Gen : String; Value : String);
+   Apply_Foreign_Override : Apply_Foreign_Override_Access;
+
    --  Add an override for generic ID.
-   procedure Add_Generic_Override (Id : Name_Id; Value : String);
+   procedure Add_Generic_Override (Name : String; Value : String);
 
    --  Apply generic overrides to entity ENT.
    procedure Apply_Generic_Override (Ent : Iir);