ghdldrv,configure: allow LIB.UNIT name for -e/-r commands. Fix #1718

8 files changed, 129 insertions, 38 deletions

diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb
index c62348752..c778ecfb5 100644
--- a/src/ghdldrv/ghdlcomp.adb
+++ b/src/ghdldrv/ghdlcomp.adb
@@ -327,14 +327,15 @@ package body Ghdlcomp is
                                   Opt_Arg : out Natural;
                                   Config : out Iir)
    is
+      Lib_Id : Name_Id;
       Prim_Id : Name_Id;
       Sec_Id : Name_Id;
    begin
-      Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg, Prim_Id, Sec_Id);
+      Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg, Lib_Id, Prim_Id, Sec_Id);
 
       Flags.Flag_Elaborate := True;
 
-      Config := Vhdl.Configuration.Configure (Prim_Id, Sec_Id);
+      Config := Vhdl.Configuration.Configure (Lib_Id, Prim_Id, Sec_Id);
       if Config = Null_Iir
         or else Errorout.Nbr_Errors > 0
       then
@@ -730,6 +731,7 @@ package body Ghdlcomp is
    is
       pragma Unreferenced (Cmd);
 
+      Lib_Id : Name_Id;
       Prim_Id : Name_Id;
       Sec_Id : Name_Id;
       Files_List : Iir_List;
@@ -741,13 +743,13 @@ package body Ghdlcomp is
       Unit : Iir_Design_Unit;
       Lib : Iir_Library_Declaration;
    begin
-      Extract_Elab_Unit ("-m", Args, Next_Arg, Prim_Id, Sec_Id);
+      Extract_Elab_Unit ("-m", Args, Next_Arg, Lib_Id, Prim_Id, Sec_Id);
       if not Setup_Libraries (True) then
          return;
       end if;
 
       --  Create list of files.
-      Files_List := Build_Dependence (Prim_Id, Sec_Id);
+      Files_List := Build_Dependence (Lib_Id, Prim_Id, Sec_Id);
 
       --  Unmark all libraries.
       Lib := Libraries.Std_Library;
@@ -874,6 +876,7 @@ package body Ghdlcomp is
       use Name_Table;
 
       HT : constant Character := ASCII.HT;
+      Lib_Id : Name_Id;
       Prim_Id : Name_Id;
       Sec_Id : Name_Id;
       Files_List : Iir_List;
@@ -885,11 +888,12 @@ package body Ghdlcomp is
 
       Next_Arg : Natural;
    begin
-      Extract_Elab_Unit ("--gen-makefile", Args, Next_Arg, Prim_Id, Sec_Id);
+      Extract_Elab_Unit
+        ("--gen-makefile", Args, Next_Arg, Lib_Id, Prim_Id, Sec_Id);
       if not Setup_Libraries (True) then
          return;
       end if;
-      Files_List := Build_Dependence (Prim_Id, Sec_Id);
+      Files_List := Build_Dependence (Lib_Id, Prim_Id, Sec_Id);
 
       Ghdllocal.Gen_Makefile_Disp_Header;
 
diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb
index fea5a9a40..2d56dd821 100644
--- a/src/ghdldrv/ghdldrv.adb
+++ b/src/ghdldrv/ghdldrv.adb
@@ -954,6 +954,7 @@ package body Ghdldrv is
 
    --  Elaboration.
 
+   Library_Id : Name_Id;
    Primary_Id : Name_Id;
    Secondary_Id : Name_Id;
    Base_Name : String_Access;
@@ -964,19 +965,39 @@ package body Ghdldrv is
    procedure Set_Elab_Units (Cmd : in out Command_Comp'Class;
                              Cmd_Name : String;
                              Args : Argument_List;
-                             Run_Arg : out Natural) is
+                             Run_Arg : out Natural)
+   is
+      function Library_Prefix_Image (Id : Name_Id) return String is
+      begin
+         if Id = Null_Identifier then
+            return "";
+         else
+            return Image (Id) & '.';
+         end if;
+      end Library_Prefix_Image;
+
+      function Arch_Suffix_Image (Id : Name_Id) return String is
+      begin
+         if Id = Null_Identifier then
+            return "";
+         else
+            return '(' & Image (Id) & ')';
+         end if;
+      end Arch_Suffix_Image;
    begin
-      Extract_Elab_Unit (Cmd_Name, Args, Run_Arg, Primary_Id, Secondary_Id);
+      Library_Id := Null_Identifier;
+      Extract_Elab_Unit (Cmd_Name, Args, Run_Arg,
+                         Library_Id, Primary_Id, Secondary_Id);
       if Secondary_Id = Null_Identifier then
          Base_Name := new String'(Image (Primary_Id));
-         Unit_Name := new String'(Image (Primary_Id));
       else
-         Base_Name :=
-           new String'(Image (Primary_Id) & '-' & Image (Secondary_Id));
-         Unit_Name :=
-           new String'(Image (Primary_Id) & '(' & Image (Secondary_Id) & ')');
+         Base_Name := new String'(Image (Primary_Id)
+                                    & '-' & Image (Secondary_Id));
       end if;
 
+      Unit_Name := new String'(Library_Prefix_Image (Library_Id)
+                                 & Image (Primary_Id)
+                                 & Arch_Suffix_Image (Secondary_Id));
       Filelist_Name := null;
 
       --  Choose a default name for the executable.
@@ -1231,11 +1252,12 @@ package body Ghdldrv is
    procedure Perform_Action (Cmd : in out Command_Run; Args : Argument_List)
    is
       Suffix : constant String_Access := Get_Executable_Suffix;
+      Lib_Id : Name_Id;
       Prim_Id : Name_Id;
       Sec_Id : Name_Id;
       Opt_Arg : Natural;
    begin
-      Extract_Elab_Unit ("-r", Args, Opt_Arg, Prim_Id, Sec_Id);
+      Extract_Elab_Unit ("-r", Args, Opt_Arg, Lib_Id, Prim_Id, Sec_Id);
       if Sec_Id = Null_Identifier then
          Base_Name := new String'
            (Image (Prim_Id) & Suffix.all);
@@ -1614,7 +1636,7 @@ package body Ghdldrv is
       Setup_Compiler (Cmd, True);
 
       --  Create list of files.
-      Files_List := Build_Dependence (Primary_Id, Secondary_Id);
+      Files_List := Build_Dependence (Library_Id, Primary_Id, Secondary_Id);
 
       if Errorout.Nbr_Errors /= 0 then
          raise Errorout.Compilation_Error;
@@ -1885,7 +1907,7 @@ package body Ghdldrv is
       if not Setup_Libraries (True) then
          raise Option_Error;
       end if;
-      Files_List := Build_Dependence (Primary_Id, Secondary_Id);
+      Files_List := Build_Dependence (Library_Id, Primary_Id, Secondary_Id);
 
       Ghdllocal.Gen_Makefile_Disp_Header;
 
diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb
index b77992520..92a7e1c7e 100644
--- a/src/ghdldrv/ghdllocal.adb
+++ b/src/ghdldrv/ghdllocal.adb
@@ -1437,7 +1437,8 @@ package body Ghdllocal is
       end loop;
    end Check_No_Elab_Flag;
 
-   function Build_Dependence (Prim : Name_Id; Sec : Name_Id) return Iir_List
+   function Build_Dependence (Lib : Name_Id; Prim : Name_Id; Sec : Name_Id)
+                             return Iir_List
    is
       procedure Build_Dependence_List (File : Iir_Design_File; List : Iir_List)
       is
@@ -1515,7 +1516,7 @@ package body Ghdllocal is
       Flag_Load_All_Design_Units := True;
       Flag_Build_File_Dependence := True;
 
-      Top := Configure (Prim, Sec);
+      Top := Configure (Lib, Prim, Sec);
       if Top = Null_Iir then
          --  Error during configuration (primary unit not found).
          raise Option_Error;
@@ -1742,6 +1743,7 @@ package body Ghdllocal is
    procedure Extract_Elab_Unit (Cmd_Name : String;
                                 Args : Argument_List;
                                 Next_Arg : out Natural;
+                                Lib_Id : out Name_Id;
                                 Prim_Id : out Name_Id;
                                 Sec_Id : out Name_Id) is
    begin
@@ -1750,10 +1752,40 @@ package body Ghdllocal is
          raise Option_Error;
       end if;
 
-      Prim_Id := Convert_Name (Args (Args'First).all);
-      if Prim_Id = Null_Identifier then
-         raise Option_Error;
-      end if;
+      declare
+         S : constant String_Access := Args (Args'First);
+         Dot : Natural;
+      begin
+         Lib_Id := Null_Identifier;
+
+         Dot := S'First - 1;
+         if S (S'First) /= '\' then
+            for I in S'Range loop
+               if S (I) = '.' then
+                  if I = S'First then
+                     Error ("missing library name before '.'");
+                     raise Option_Error;
+                  end if;
+                  if I = S'Last then
+                     Error ("missing primary name after '.'");
+                     raise Option_Error;
+                  end if;
+                  Dot := I;
+                  Lib_Id := Convert_Name (S (S'First .. Dot - 1));
+                  if Lib_Id = Null_Identifier then
+                     raise Option_Error;
+                  end if;
+                  exit;
+               end if;
+            end loop;
+         end if;
+
+         Prim_Id := Convert_Name (S (Dot + 1 .. S'Last));
+         if Prim_Id = Null_Identifier then
+            raise Option_Error;
+         end if;
+      end;
+
       Next_Arg := Args'First + 1;
       Sec_Id := Null_Identifier;
 
@@ -1828,6 +1860,7 @@ package body Ghdllocal is
       pragma Unreferenced (Cmd);
       use Name_Table;
 
+      Lib_Id : Name_Id;
       Prim_Id : Name_Id;
       Sec_Id : Name_Id;
       Files_List : Iir_List;
@@ -1838,11 +1871,12 @@ package body Ghdllocal is
 
       Next_Arg : Natural;
    begin
-      Extract_Elab_Unit ("--elab-order", Args, Next_Arg, Prim_Id, Sec_Id);
+      Extract_Elab_Unit
+        ("--elab-order", Args, Next_Arg, Lib_Id, Prim_Id, Sec_Id);
       if not Setup_Libraries (True) then
          return;
       end if;
-      Files_List := Build_Dependence (Prim_Id, Sec_Id);
+      Files_List := Build_Dependence (Lib_Id, Prim_Id, Sec_Id);
 
       Files_It := List_Iterate (Files_List);
       while Is_Valid (Files_It) loop
diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads
index 2d0ddb7a8..c182f6c0e 100644
--- a/src/ghdldrv/ghdllocal.ads
+++ b/src/ghdldrv/ghdllocal.ads
@@ -130,7 +130,8 @@ package Ghdllocal is
    --  Raise errorout.compilation_error in case of error (parse error).
    procedure Load_All_Libraries_And_Files;
 
-   function Build_Dependence (Prim : Name_Id; Sec : Name_Id) return Iir_List;
+   function Build_Dependence (Lib : Name_Id; Prim : Name_Id; Sec : Name_Id)
+                             return Iir_List;
 
    --  Return True iff file FILE has been modified (the file time stamp does
    --  no correspond to what was recorded in the library).
@@ -144,6 +145,7 @@ package Ghdllocal is
    procedure Extract_Elab_Unit (Cmd_Name : String;
                                 Args : Argument_List;
                                 Next_Arg : out Natural;
+                                Lib_Id : out Name_Id;
                                 Prim_Id : out Name_Id;
                                 Sec_Id : out Name_Id);
 
diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index b0c85ba26..d95ea55e3 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -247,6 +247,7 @@ package body Ghdlsynth is
       Design_File : Iir;
       Config : Iir;
       Top : Iir;
+      Lib_Id : Name_Id;
       Prim_Id : Name_Id;
       Sec_Id : Name_Id;
    begin
@@ -359,18 +360,19 @@ package body Ghdlsynth is
             --  No need to configure if there are missing units.
             return Null_Iir;
          end if;
+         Lib_Id := Null_Identifier;
          Prim_Id := Get_Identifier (Top);
          Sec_Id := Null_Identifier;
       else
          Extract_Elab_Unit ("--synth", Args (E_Opt + 1 .. Args'Last), Opt_Arg,
-                            Prim_Id, Sec_Id);
+                            Lib_Id, Prim_Id, Sec_Id);
          if Opt_Arg <= Args'Last then
             Ghdlmain.Error ("extra options ignored");
             return Null_Iir;
          end if;
       end if;
 
-      Config := Vhdl.Configuration.Configure (Prim_Id, Sec_Id);
+      Config := Vhdl.Configuration.Configure (Lib_Id, Prim_Id, Sec_Id);
 
       if Nbr_Errors > 0 then
          --  No need to configure if there are missing units.
diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb
index 8823705bb..a1364a243 100644
--- a/src/vhdl/translate/ortho_front.adb
+++ b/src/vhdl/translate/ortho_front.adb
@@ -58,9 +58,9 @@ package body Ortho_Front is
       );
    Action : Action_Type := Action_Compile;
 
-   --  Name of the entity to elaborate.
+   --  Name of the library/entity/architecture to elaborate.
+   Elab_Library : Name_Id;
    Elab_Entity : Name_Id;
-   --  Name of the architecture to elaborate.
    Elab_Architecture : Name_Id;
    --  Filename for the list of files to link.
    Elab_Filelist : String_Acc;
@@ -90,13 +90,16 @@ package body Ortho_Front is
       Options.Initialize;
 
       Elab_Filelist := null;
+      Elab_Library := Null_Identifier;
       Elab_Entity := Null_Identifier;
       Elab_Architecture := Null_Identifier;
       Flag_Expect_Failure := False;
    end Init;
 
    function Decode_Elab_Option (Arg : String_Acc; Cmd : String)
-                               return Natural is
+                               return Natural
+   is
+      Dot : Natural;
    begin
       Elab_Architecture := Null_Identifier;
       --  Entity (+ architecture) to elaborate
@@ -105,6 +108,19 @@ package body Ortho_Front is
            ("entity or configuration name required after " & Cmd);
          return 0;
       end if;
+
+      Dot := Arg'First - 1;
+      if Arg (Arg'First) /= '\' then
+         for I in Arg'Range loop
+            if Arg (I) = '.' then
+               Dot := I;
+               Elab_Library :=
+                 Name_Table.Get_Identifier (Arg (Arg'First .. I - 1));
+               exit;
+            end if;
+         end loop;
+      end if;
+
       if Arg (Arg.all'Last) = ')' then
          --  Name is ENTITY(ARCH).
          --  Split.
@@ -128,7 +144,7 @@ package body Ortho_Front is
                Is_Ext := False;
             end if;
             loop
-               if P = Arg.all'First then
+               if P = Dot + 1 then
                   Error_Msg_Option ("ill-formed name after " & Cmd);
                   return 0;
                end if;
@@ -150,10 +166,10 @@ package body Ortho_Front is
             Elab_Architecture :=
               Name_Table.Get_Identifier (Arg (P + 1 .. Arg'Last - 1));
             Elab_Entity :=
-              Name_Table.Get_Identifier (Arg (Arg'First .. P - 1));
+              Name_Table.Get_Identifier (Arg (Dot + 1 .. P - 1));
          end;
       else
-         Elab_Entity := Name_Table.Get_Identifier (Arg.all);
+         Elab_Entity := Name_Table.Get_Identifier (Arg (Dot + 1 .. Arg'Last));
          Elab_Architecture := Null_Identifier;
       end if;
       return 2;
@@ -567,7 +583,7 @@ package body Ortho_Front is
             Shlib_Interning.Init;
 
             Config := Vhdl.Configuration.Configure
-              (Elab_Entity, Elab_Architecture);
+              (Elab_Library, Elab_Entity, Elab_Architecture);
             if Errorout.Nbr_Errors > 0 then
                --  This may happen (bad entity for example).
                raise Compilation_Error;
@@ -626,7 +642,7 @@ package body Ortho_Front is
             Flags.Flag_Elaborate := True;
             Flags.Flag_Only_Elab_Warnings := False;
             Config := Vhdl.Configuration.Configure
-              (Elab_Entity, Elab_Architecture);
+              (Elab_Library, Elab_Entity, Elab_Architecture);
             Translation.Elaborate (Config, True);
 
             if Errorout.Nbr_Errors > 0 then
diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb
index 395888d69..ad086cd3d 100644
--- a/src/vhdl/vhdl-configuration.adb
+++ b/src/vhdl/vhdl-configuration.adb
@@ -638,16 +638,26 @@ package body Vhdl.Configuration is
    --  corresponding configurations.
    --
    --  Return the configuration declaration for the design.
-   function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id)
+   function Configure
+     (Library_Id: Name_Id; Primary_Id : Name_Id; Secondary_Id : Name_Id)
      return Iir
    is
       use Libraries;
 
+      Library : Iir;
       Unit : Iir_Design_Unit;
       Lib_Unit : Iir;
       Top : Iir;
    begin
-      Unit := Find_Primary_Unit (Work_Library, Primary_Id);
+      if Library_Id /= Null_Identifier then
+         Library := Get_Library (Library_Id, Command_Line_Location);
+         if Library = Null_Iir then
+            return Null_Iir;
+         end if;
+      else
+         Library := Work_Library;
+      end if;
+      Unit := Find_Primary_Unit (Library, Primary_Id);
       if Unit = Null_Iir then
          Error_Msg_Elab ("cannot find entity or configuration "
                          & Name_Table.Image (Primary_Id));
diff --git a/src/vhdl/vhdl-configuration.ads b/src/vhdl/vhdl-configuration.ads
index c9fd50850..1abff5057 100644
--- a/src/vhdl/vhdl-configuration.ads
+++ b/src/vhdl/vhdl-configuration.ads
@@ -33,7 +33,8 @@ package Vhdl.Configuration is
    --  creates a list of design unit.
    --  and return the top configuration.
    --  Note: this set the Elab_Flag on units.
-   function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id)
+   function Configure
+     (Library_Id : Name_Id; Primary_Id : Name_Id; Secondary_Id : Name_Id)
      return Iir;
 
    --  Add design unit UNIT (with its dependences) in the design_units table.