diff mbox

[Ada] Visibility problem using Import aspect

Message ID 20170425092859.GA47984@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet April 25, 2017, 9:28 a.m. UTC 
This patch corrects an issue whereby an import aspect used within a generic
package would fail to resolve. By analyzing the expresions within the aspect's
arguments (a.k.a "interfacing" aspects) in addition to the generated pragma's
arguments the generic template gets properly resolved names for instance
creation.

------------
-- Source --
------------

--  p.ads

package P is
   type T1 is new Integer;
end P;

--  p-q.ads

generic package P.Q is
   type T2 is new Integer;
end P.Q;

--  p-q-r.adb

with Ada.Text_IO;
with P.W.Z;

package body P.Q.R is

   X : constant Integer
   with Import,
        Convention    => Ada,
        External_Name => W.Z.S;

   procedure Proc is
   begin
      Ada.Text_IO.Put_Line (Item => X'Img);
   end Proc;

end P.Q.R;

--  p-q-r.ads

generic package P.Q.R is
   procedure Proc;
end P.Q.R;

--  p-w.ads

package P.W is
   type T3 is new Integer;
end P.W;

--  p-w-z.ads

package P.W.Z is
   S : constant String := "Halloween";
end P.W.Z;

--  x.ads

with P.Q.R;

package X is

   package X1 is new P.Q;

   package X2 is new X1.R;

end X;

----------------------------
-- Compilation and output --
----------------------------

$ gcc -c x.ads

Tested on x86_64-pc-linux-gnu, committed on trunk

2017-04-25  Justin Squirek  <squirek@adacore.com>

	* sem_ch13.adb (Get_Interfacing_Aspects): Moved to sem_util.adb.
	* sem_prag.adb (Analyze_Pragma, Process_Import_Or_Interface):
	Add extra parameter for Process_Interface_Name.
	(Process_Interface_Name): Add parameter for pragma to analyze
	corresponding aspect.
	* sem_util.ads, sem_util.adb (Get_Interfacing_Aspects): Added
	from sem_ch13.adb
diff mbox

Patch

Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 247146)
+++ sem_ch13.adb	(working copy)
@@ -147,27 +147,6 @@ 
    --  Uint value. If the value is inappropriate, then error messages are
    --  posted as required, and a value of No_Uint is returned.
 
-   procedure Get_Interfacing_Aspects
-     (Iface_Asp : Node_Id;
-      Conv_Asp  : out Node_Id;
-      EN_Asp    : out Node_Id;
-      Expo_Asp  : out Node_Id;
-      Imp_Asp   : out Node_Id;
-      LN_Asp    : out Node_Id;
-      Do_Checks : Boolean := False);
-   --  Given a single interfacing aspect Iface_Asp, retrieve other interfacing
-   --  aspects that apply to the same related entity. The aspects considered by
-   --  this routine are as follows:
-   --
-   --    Conv_Asp - aspect Convention
-   --    EN_Asp   - aspect External_Name
-   --    Expo_Asp - aspect Export
-   --    Imp_Asp  - aspect Import
-   --    LN_Asp   - aspect Link_Name
-   --
-   --  When flag Do_Checks is set, this routine will flag duplicate uses of
-   --  aspects.
-
    function Is_Operational_Item (N : Node_Id) return Boolean;
    --  A specification for a stream attribute is allowed before the full type
    --  is declared, as explained in AI-00137 and the corrigendum. Attributes
@@ -11214,106 +11193,6 @@ 
       end if;
    end Get_Alignment_Value;
 
-   -----------------------------
-   -- Get_Interfacing_Aspects --
-   -----------------------------
-
-   procedure Get_Interfacing_Aspects
-     (Iface_Asp : Node_Id;
-      Conv_Asp  : out Node_Id;
-      EN_Asp    : out Node_Id;
-      Expo_Asp  : out Node_Id;
-      Imp_Asp   : out Node_Id;
-      LN_Asp    : out Node_Id;
-      Do_Checks : Boolean := False)
-   is
-      procedure Save_Or_Duplication_Error
-        (Asp : Node_Id;
-         To  : in out Node_Id);
-      --  Save the value of aspect Asp in node To. If To already has a value,
-      --  then this is considered a duplicate use of aspect. Emit an error if
-      --  flag Do_Checks is set.
-
-      -------------------------------
-      -- Save_Or_Duplication_Error --
-      -------------------------------
-
-      procedure Save_Or_Duplication_Error
-        (Asp : Node_Id;
-         To  : in out Node_Id)
-      is
-      begin
-         --  Detect an extra aspect and issue an error
-
-         if Present (To) then
-            if Do_Checks then
-               Error_Msg_Name_1 := Chars (Identifier (Asp));
-               Error_Msg_Sloc   := Sloc (To);
-               Error_Msg_N ("aspect % previously given #", Asp);
-            end if;
-
-         --  Otherwise capture the aspect
-
-         else
-            To := Asp;
-         end if;
-      end Save_Or_Duplication_Error;
-
-      --  Local variables
-
-      Asp    : Node_Id;
-      Asp_Id : Aspect_Id;
-
-      --  The following variables capture each individual aspect
-
-      Conv : Node_Id := Empty;
-      EN   : Node_Id := Empty;
-      Expo : Node_Id := Empty;
-      Imp  : Node_Id := Empty;
-      LN   : Node_Id := Empty;
-
-   --  Start of processing for Get_Interfacing_Aspects
-
-   begin
-      --  The input interfacing aspect should reside in an aspect specification
-      --  list.
-
-      pragma Assert (Is_List_Member (Iface_Asp));
-
-      --  Examine the aspect specifications of the related entity. Find and
-      --  capture all interfacing aspects. Detect duplicates and emit errors
-      --  if applicable.
-
-      Asp := First (List_Containing (Iface_Asp));
-      while Present (Asp) loop
-         Asp_Id := Get_Aspect_Id (Asp);
-
-         if Asp_Id = Aspect_Convention then
-            Save_Or_Duplication_Error (Asp, Conv);
-
-         elsif Asp_Id = Aspect_External_Name then
-            Save_Or_Duplication_Error (Asp, EN);
-
-         elsif Asp_Id = Aspect_Export then
-            Save_Or_Duplication_Error (Asp, Expo);
-
-         elsif Asp_Id = Aspect_Import then
-            Save_Or_Duplication_Error (Asp, Imp);
-
-         elsif Asp_Id = Aspect_Link_Name then
-            Save_Or_Duplication_Error (Asp, LN);
-         end if;
-
-         Next (Asp);
-      end loop;
-
-      Conv_Asp := Conv;
-      EN_Asp   := EN;
-      Expo_Asp := Expo;
-      Imp_Asp  := Imp;
-      LN_Asp   := LN;
-   end Get_Interfacing_Aspects;
-
    -------------------------------------
    -- Inherit_Aspects_At_Freeze_Point --
    -------------------------------------
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 247157)
+++ sem_prag.adb	(working copy)
@@ -3927,7 +3927,8 @@ 
       procedure Process_Interface_Name
         (Subprogram_Def : Entity_Id;
          Ext_Arg        : Node_Id;
-         Link_Arg       : Node_Id);
+         Link_Arg       : Node_Id;
+         Prag           : Node_Id);
       --  Given the last two arguments of pragma Import, pragma Export, or
       --  pragma Interface_Name, performs validity checks and sets the
       --  Interface_Name field of the given subprogram entity to the
@@ -3936,7 +3937,9 @@ 
       --  Ext_Arg may represent the Link_Name if Link_Arg is missing, and
       --  appropriate named notation is used for Ext_Arg. If neither Ext_Arg
       --  nor Link_Arg is present, the interface name is set to the default
-      --  from the subprogram name.
+      --  from the subprogram name. In addition, the pragma itself is passed
+      --  to analyze any expressions in the case the pragma came from an aspect
+      --  specification.
 
       procedure Process_Interrupt_Or_Attach_Handler;
       --  Common processing for Interrupt and Attach_Handler pragmas
@@ -8421,7 +8424,7 @@ 
                   Set_Imported (Def_Id);
                end if;
 
-               Process_Interface_Name (Def_Id, Arg3, Arg4);
+               Process_Interface_Name (Def_Id, Arg3, Arg4, N);
 
                --  Note that we do not set Is_Public here. That's because we
                --  only want to set it if there is no address clause, and we
@@ -8583,7 +8586,7 @@ 
                      end if;
                   end;
 
-                  Process_Interface_Name (Def_Id, Arg3, Arg4);
+                  Process_Interface_Name (Def_Id, Arg3, Arg4, N);
                end if;
 
                if Is_Compilation_Unit (Hom_Id) then
@@ -9128,7 +9131,8 @@ 
       procedure Process_Interface_Name
         (Subprogram_Def : Entity_Id;
          Ext_Arg        : Node_Id;
-         Link_Arg       : Node_Id)
+         Link_Arg       : Node_Id;
+         Prag           : Node_Id)
       is
          Ext_Nam    : Node_Id;
          Link_Nam   : Node_Id;
@@ -9179,6 +9183,40 @@ 
       --  Start of processing for Process_Interface_Name
 
       begin
+         --  If we are looking at a pragma that comes from an aspect then it
+         --  needs to have its corresponding aspect argument expressions
+         --  analyzed in addition to the generated pragma so that aspects
+         --  within generic units get properly resolved.
+
+         if Present (Prag) and then From_Aspect_Specification (Prag) then
+            declare
+               Asp     : constant Node_Id := Corresponding_Aspect (Prag);
+               Dummy_1 : Node_Id;
+               Dummy_2 : Node_Id;
+               Dummy_3 : Node_Id;
+               EN      : Node_Id;
+               LN      : Node_Id;
+
+            begin
+               --  Obtain all interfacing aspects used to construct the pragma
+
+               Get_Interfacing_Aspects
+                 (Asp, Dummy_1, EN, Dummy_2, Dummy_3, LN);
+
+               --  Analyze the expression of aspect External_Name
+
+               if Present (EN) then
+                  Analyze (Expression (EN));
+               end if;
+
+               --  Analyze the expressio of aspect Link_Name
+
+               if Present (LN) then
+                  Analyze (Expression (LN));
+               end if;
+            end;
+         end if;
+
          if No (Link_Arg) then
             if No (Ext_Arg) then
                return;
@@ -13497,7 +13535,7 @@ 
                if Arg_Count >= 2 then
                   Set_Imported (Def_Id);
                   Set_Is_Public (Def_Id);
-                  Process_Interface_Name (Def_Id, Arg2, Arg3);
+                  Process_Interface_Name (Def_Id, Arg2, Arg3, N);
                end if;
 
                Set_Has_Completion (Def_Id);
@@ -14648,7 +14686,7 @@ 
                     (Get_Pragma_Arg (Arg2), Sure => False);
                end if;
 
-               Process_Interface_Name (Def_Id, Arg3, Arg4);
+               Process_Interface_Name (Def_Id, Arg3, Arg4, N);
                Set_Exported (Def_Id, Arg2);
             end if;
 
@@ -15154,7 +15192,7 @@ 
 
             Note_Possible_Modification
               (Get_Pragma_Arg (Arg2), Sure => False);
-            Process_Interface_Name (E, Arg3, Arg4);
+            Process_Interface_Name (E, Arg3, Arg4, N);
             Set_Exported (E, Arg2);
          end External;
 
@@ -16607,7 +16645,7 @@ 
                   end if;
 
                   Set_Is_Public (Def_Id);
-                  Process_Interface_Name (Def_Id, Arg2, Arg3);
+                  Process_Interface_Name (Def_Id, Arg2, Arg3, N);
                end if;
 
             --  Otherwise must be subprogram
@@ -16627,7 +16665,7 @@ 
                   Def_Id := Get_Base_Subprogram (Hom_Id);
 
                   if Is_Imported (Def_Id) then
-                     Process_Interface_Name (Def_Id, Arg2, Arg3);
+                     Process_Interface_Name (Def_Id, Arg2, Arg3, N);
                      Found := True;
                   end if;
 
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 247156)
+++ sem_util.adb	(working copy)
@@ -8181,6 +8181,106 @@ 
       end if;
    end Get_Index_Bounds;
 
+   -----------------------------
+   -- Get_Interfacing_Aspects --
+   -----------------------------
+
+   procedure Get_Interfacing_Aspects
+     (Iface_Asp : Node_Id;
+      Conv_Asp  : out Node_Id;
+      EN_Asp    : out Node_Id;
+      Expo_Asp  : out Node_Id;
+      Imp_Asp   : out Node_Id;
+      LN_Asp    : out Node_Id;
+      Do_Checks : Boolean := False)
+   is
+      procedure Save_Or_Duplication_Error
+        (Asp : Node_Id;
+         To  : in out Node_Id);
+      --  Save the value of aspect Asp in node To. If To already has a value,
+      --  then this is considered a duplicate use of aspect. Emit an error if
+      --  flag Do_Checks is set.
+
+      -------------------------------
+      -- Save_Or_Duplication_Error --
+      -------------------------------
+
+      procedure Save_Or_Duplication_Error
+        (Asp : Node_Id;
+         To  : in out Node_Id)
+      is
+      begin
+         --  Detect an extra aspect and issue an error
+
+         if Present (To) then
+            if Do_Checks then
+               Error_Msg_Name_1 := Chars (Identifier (Asp));
+               Error_Msg_Sloc   := Sloc (To);
+               Error_Msg_N ("aspect % previously given #", Asp);
+            end if;
+
+         --  Otherwise capture the aspect
+
+         else
+            To := Asp;
+         end if;
+      end Save_Or_Duplication_Error;
+
+      --  Local variables
+
+      Asp    : Node_Id;
+      Asp_Id : Aspect_Id;
+
+      --  The following variables capture each individual aspect
+
+      Conv : Node_Id := Empty;
+      EN   : Node_Id := Empty;
+      Expo : Node_Id := Empty;
+      Imp  : Node_Id := Empty;
+      LN   : Node_Id := Empty;
+
+   --  Start of processing for Get_Interfacing_Aspects
+
+   begin
+      --  The input interfacing aspect should reside in an aspect specification
+      --  list.
+
+      pragma Assert (Is_List_Member (Iface_Asp));
+
+      --  Examine the aspect specifications of the related entity. Find and
+      --  capture all interfacing aspects. Detect duplicates and emit errors
+      --  if applicable.
+
+      Asp := First (List_Containing (Iface_Asp));
+      while Present (Asp) loop
+         Asp_Id := Get_Aspect_Id (Asp);
+
+         if Asp_Id = Aspect_Convention then
+            Save_Or_Duplication_Error (Asp, Conv);
+
+         elsif Asp_Id = Aspect_External_Name then
+            Save_Or_Duplication_Error (Asp, EN);
+
+         elsif Asp_Id = Aspect_Export then
+            Save_Or_Duplication_Error (Asp, Expo);
+
+         elsif Asp_Id = Aspect_Import then
+            Save_Or_Duplication_Error (Asp, Imp);
+
+         elsif Asp_Id = Aspect_Link_Name then
+            Save_Or_Duplication_Error (Asp, LN);
+         end if;
+
+         Next (Asp);
+      end loop;
+
+      Conv_Asp := Conv;
+      EN_Asp   := EN;
+      Expo_Asp := Expo;
+      Imp_Asp  := Imp;
+      LN_Asp   := LN;
+   end Get_Interfacing_Aspects;
+
    ---------------------------------
    -- Get_Iterable_Type_Primitive --
    ---------------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 247156)
+++ sem_util.ads	(working copy)
@@ -923,6 +923,27 @@ 
    --  the index type turns out to be a partial view; this case should not
    --  arise during normal compilation of semantically correct programs.
 
+   procedure Get_Interfacing_Aspects
+     (Iface_Asp : Node_Id;
+      Conv_Asp  : out Node_Id;
+      EN_Asp    : out Node_Id;
+      Expo_Asp  : out Node_Id;
+      Imp_Asp   : out Node_Id;
+      LN_Asp    : out Node_Id;
+      Do_Checks : Boolean := False);
+   --  Given a single interfacing aspect Iface_Asp, retrieve other interfacing
+   --  aspects that apply to the same related entity. The aspects considered by
+   --  this routine are as follows:
+   --
+   --    Conv_Asp - aspect Convention
+   --    EN_Asp   - aspect External_Name
+   --    Expo_Asp - aspect Export
+   --    Imp_Asp  - aspect Import
+   --    LN_Asp   - aspect Link_Name
+   --
+   --  When flag Do_Checks is set, this routine will flag duplicate uses of
+   --  aspects.
+
    function Get_Enum_Lit_From_Pos
      (T   : Entity_Id;
       Pos : Uint;