vhdl: fix use clause of a package with interface subprograms.

Fix #2250

5 files changed, 63 insertions, 20 deletions

diff --git a/src/vhdl/vhdl-sem_assocs.adb b/src/vhdl/vhdl-sem_assocs.adb
index 3bf51c400..a28ebe12e 100644
--- a/src/vhdl/vhdl-sem_assocs.adb
+++ b/src/vhdl/vhdl-sem_assocs.adb
@@ -2468,7 +2468,8 @@ package body Vhdl.Sem_Assocs is
          Warn_Hide_Enabled := Is_Warning_Enabled (Warnid_Hide);
          Enable_Warning (Warnid_Hide, False);
 
-         Sem_Scopes.Add_Declarations_From_Interface_Chain (Interface_Chain);
+         Sem_Scopes.Add_Declarations_From_Interface_Chain
+           (Interface_Chain, False);
 
          Enable_Warning (Warnid_Hide, Warn_Hide_Enabled);
 
diff --git a/src/vhdl/vhdl-sem_inst.adb b/src/vhdl/vhdl-sem_inst.adb
index d8f2728ab..4c250d2f4 100644
--- a/src/vhdl/vhdl-sem_inst.adb
+++ b/src/vhdl/vhdl-sem_inst.adb
@@ -1026,6 +1026,9 @@ package body Vhdl.Sem_Inst is
                     Get_Named_Entity (Get_Actual (Assoc));
                begin
                   Set_Instance (Get_Origin (Assoc_Formal), Actual_Subprg);
+                  --  Also set the associated subprogram to the interface
+                  --  subprogram, so that it can referenced through its name.
+                  Set_Associated_Subprogram (Assoc_Formal, Actual_Subprg);
                end;
             end if;
          when others =>
diff --git a/src/vhdl/vhdl-sem_scopes.adb b/src/vhdl/vhdl-sem_scopes.adb
index fd690f364..fcc2707fa 100644
--- a/src/vhdl/vhdl-sem_scopes.adb
+++ b/src/vhdl/vhdl-sem_scopes.adb
@@ -1007,8 +1007,7 @@ package body Vhdl.Sem_Scopes is
       Set_Visible_Flag (Decl, True);
    end Name_Visible;
 
-   procedure Iterator_Decl (Decl : Iir; Arg : Arg_Type)
-   is
+   procedure Iterator_Decl (Decl : Iir; Arg : Arg_Type) is
    begin
       case Get_Kind (Decl) is
          when Iir_Kind_Subtype_Declaration
@@ -1229,23 +1228,57 @@ package body Vhdl.Sem_Scopes is
    procedure Add_Declarations_List is new Iterator_Decl_List
      (Arg_Type => Boolean, Handle_Decl => Add_Declaration);
 
-   procedure Add_Declarations_From_Interface_Chain (Chain : Iir)
+   procedure Add_Declarations_From_Interface_Chain
+     (Chain : Iir; Potentially : Boolean)
    is
-      El : Iir;
+      Inter : Iir;
+      Assoc : Iir;
       Id : Name_Id;
    begin
-      El := Chain;
-      while El /= Null_Iir loop
-         Id := Get_Identifier (El);
+      Inter := Chain;
+      while Inter /= Null_Iir loop
+         Id := Get_Identifier (Inter);
 
          --  The chain may be from an implicitely declared subprograms, with
          --  anonymous identifiers.  In that case, all interfaces are
          --  anonymous and there is no need to iterate.
          exit when Id = Null_Identifier;
 
-         Add_Declaration (El, False);
+         --  Not very different from Add_Declaration, except for interface
+         --  subprograms.
+         case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
+            when Iir_Kinds_Interface_Object_Declaration
+              | Iir_Kind_Interface_Package_Declaration
+              | Iir_Kind_Interface_Terminal_Declaration =>
+               Add_Name (Inter, Id, Potentially);
+            when Iir_Kinds_Interface_Subprogram_Declaration =>
+               if Potentially then
+                  --  The normal case: an interface subprogram in a package
+                  --  is visible through a use clause.  But in fact it refer
+                  --  to the associated subprogram.
+                  Assoc := Get_Associated_Subprogram (Inter);
+                  pragma Assert (Assoc /= Null_Iir);
+                  Add_Name (Assoc, Id, Potentially);
+               else
+                  --  Called only when resolving associations (the identifiers
+                  --  of the interfaces are put in the name table).
+                  --  TODO: add a flag or create a different procedure ?
+                  Add_Name (Inter, Id, Potentially);
+               end if;
+            when Iir_Kind_Interface_Type_Declaration =>
+               Add_Name (Inter, Id, Potentially);
+               declare
+                  El : Iir;
+               begin
+                  El := Get_Interface_Type_Subprograms (Inter);
+                  while El /= Null_Iir loop
+                     Add_Name (El, Get_Identifier (El), Potentially);
+                     El := Get_Chain (El);
+                  end loop;
+               end;
+         end case;
 
-         El := Get_Chain (El);
+         Inter := Get_Chain (Inter);
       end loop;
    end Add_Declarations_From_Interface_Chain;
 
@@ -1278,8 +1311,10 @@ package body Vhdl.Sem_Scopes is
       --  Temporarly disable hide warning to avoid spurious messages.
       Enable_Warning (Warnid_Hide, False);
 
-      Add_Declarations_From_Interface_Chain (Get_Generic_Chain (Entity));
-      Add_Declarations_From_Interface_Chain (Get_Port_Chain (Entity));
+      Add_Declarations_From_Interface_Chain
+        (Get_Generic_Chain (Entity), False);
+      Add_Declarations_From_Interface_Chain
+        (Get_Port_Chain (Entity), False);
       Add_Declarations (Get_Declaration_Chain (Entity), False);
       Add_Declarations_Of_Concurrent_Statement (Entity);
 
@@ -1314,7 +1349,8 @@ package body Vhdl.Sem_Scopes is
       --  LRM08 4.9 Package instantiation declarations
       --  The package instantiation declaration is equivalent to declaration of
       --  a generic-mapped package, consisting of a package declaration [...]
-      Add_Declarations (Get_Generic_Chain (Decl), Potentially);
+      Add_Declarations_From_Interface_Chain
+        (Get_Generic_Chain (Decl), Potentially);
       Add_Declarations (Get_Declaration_Chain (Decl), Potentially);
    end Add_Package_Instantiation_Declarations;
 
@@ -1325,11 +1361,13 @@ package body Vhdl.Sem_Scopes is
       Add_Package_Declarations (Decl, False);
    end Add_Package_Declarations;
 
-   procedure Add_Component_Declarations (Component: Iir_Component_Declaration)
-   is
+   procedure Add_Component_Declarations
+     (Component: Iir_Component_Declaration) is
    begin
-      Add_Declarations_From_Interface_Chain (Get_Generic_Chain (Component));
-      Add_Declarations_From_Interface_Chain (Get_Port_Chain (Component));
+      Add_Declarations_From_Interface_Chain
+        (Get_Generic_Chain (Component), False);
+      Add_Declarations_From_Interface_Chain
+        (Get_Port_Chain (Component), False);
    end Add_Component_Declarations;
 
    procedure Add_Protected_Type_Declarations
diff --git a/src/vhdl/vhdl-sem_scopes.ads b/src/vhdl/vhdl-sem_scopes.ads
index b20e224b0..4622ee1a5 100644
--- a/src/vhdl/vhdl-sem_scopes.ads
+++ b/src/vhdl/vhdl-sem_scopes.ads
@@ -161,7 +161,8 @@ package Vhdl.Sem_Scopes is
 
    --  Add declarations of interface chain CHAIN into the current
    --  declarative region.
-   procedure Add_Declarations_From_Interface_Chain (Chain : Iir);
+   procedure Add_Declarations_From_Interface_Chain
+     (Chain : Iir; Potentially : Boolean);
 
    --  Add all declarations for concurrent statements declared in PARENT.
    procedure Add_Declarations_Of_Concurrent_Statement (Parent : Iir);
diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb
index c06c3e097..ad0a4bccc 100644
--- a/src/vhdl/vhdl-sem_stmts.adb
+++ b/src/vhdl/vhdl-sem_stmts.adb
@@ -2099,8 +2099,8 @@ package body Vhdl.Sem_Stmts is
          --  ... and reopen-it.
          Open_Declarative_Region;
          Set_Is_Within_Flag (Stmt, True);
-         Add_Declarations_From_Interface_Chain (Generic_Chain);
-         Add_Declarations_From_Interface_Chain (Port_Chain);
+         Add_Declarations_From_Interface_Chain (Generic_Chain, False);
+         Add_Declarations_From_Interface_Chain (Port_Chain, False);
       end if;
 
       --  LRM93 9.1