This patch fixes a visibility problem in the presence of formal packages that
have themselves formal packages declared with a box.  In a generic unit the
formals of such packages are visible, and this visibility must be properly
reflected when compiling an instance. 

The following must compile quietly:

   gcc -c -gnat05 test_extensions.adb

---
with Ada.Numerics.Generic_Real_Arrays;
with Ada.Numerics.Generic_Complex_Types;
with Ada.Numerics.Generic_Complex_Arrays;
with Whatever;
procedure Test_Extensions is

   package Real_Arrays
   is new Ada.Numerics.Generic_Real_Arrays (Float);
   package Complex_Types
   is new Ada.Numerics.Generic_Complex_Types (Float);
   package Complex_Arrays
   is new Ada.Numerics.Generic_Complex_Arrays (Real_Arrays, Complex_Types);

   package Extensions
   is new Whatever (Complex_Arrays);

begin
   null;
end Test_Extensions;
---
with Ada.Numerics.Generic_Complex_Arrays;
generic
   with package Complex_Arrays is new Ada.Numerics.Generic_Complex_Arrays (<>);
package Whatever is
   pragma Elaborate_Body;
   use Complex_Arrays;
   use Complex_Arrays.Complex_Types;
   use Complex_Arrays.Real_Arrays;
end Whatever;
---
pragma Warnings (Off);
with System.Generic_Array_Operations;
pragma Warnings (On);

package body Whatever is
   procedure Transpose_Which_Doesnt_Instantiate
   is new System.Generic_Array_Operations.Transpose
     (Scalar => Real'Base,
      Matrix => Real_Matrix);

   procedure Transpose_Which_Instantiates
   is new System.Generic_Array_Operations.Transpose
     (Scalar => Real_Arrays.Real'Base,
      Matrix => Real_Matrix);
end Whatever;

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

2014-01-22  Ed Schonberg  <schonb...@adacore.com>

        * sem_ch8.adb (From_Actual_Package): Introduce a recursive
        sub-procedure Declared_In_Actual to handle properly the visibility
        of actuals in actual packages, that are themselves actuals to a
        actual package of the current instance. This mimics properly the
        visibility of formals of formal packages declared with a box,
        within the corresponding generic unit.

Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 206928)
+++ sem_ch8.adb (working copy)
@@ -4168,10 +4168,11 @@
       --  generate the precise error message.
 
       function From_Actual_Package (E : Entity_Id) return Boolean;
-      --  Returns true if the entity is declared in a package that is
+      --  Returns true if the entity is an actual for a package that is itself
       --  an actual for a formal package of the current instance. Such an
-      --  entity requires special handling because it may be use-visible
-      --  but hides directly visible entities defined outside the instance.
+      --  entity requires special handling because it may be use-visible but
+      --  hides directly visible entities defined outside the instance, because
+      --  the corresponding formal did so in the generic.
 
       function Is_Actual_Parameter return Boolean;
       --  This function checks if the node N is an identifier that is an actual
@@ -4214,11 +4215,57 @@
 
       function From_Actual_Package (E : Entity_Id) return Boolean is
          Scop : constant Entity_Id := Scope (E);
-         Act  : Entity_Id;
+         --  Declared scope of candidate entity
 
+         Act : Entity_Id;
+
+         function Declared_In_Actual (Pack : Entity_Id) return Boolean;
+         --  Recursive function that does the work and examines actuals of
+         --  actual packages of current instance.
+
+         ------------------------
+         -- Declared_In_Actual --
+         ------------------------
+
+         function Declared_In_Actual (Pack : Entity_Id) return Boolean is
+            Act : Entity_Id;
+
+         begin
+            if No (Associated_Formal_Package (Pack)) then
+               return False;
+
+            else
+               Act := First_Entity (Pack);
+               while Present (Act) loop
+                  if Renamed_Object (Pack) = Scop then
+                     return True;
+
+                  --  Check for end of list of actuals.
+
+                  elsif Ekind (Act) = E_Package
+                    and then Renamed_Object (Act) = Pack
+                  then
+                     return False;
+
+                  elsif Ekind (Act) = E_Package
+                    and then Declared_In_Actual (Act)
+                  then
+                     return True;
+                  end if;
+
+                  Next_Entity (Act);
+               end loop;
+
+               return False;
+            end if;
+         end Declared_In_Actual;
+
+      --  Start of processing for From_Actual_Package
+
       begin
          if not In_Instance then
             return False;
+
          else
             Inst := Current_Scope;
             while Present (Inst)
@@ -4234,27 +4281,13 @@
 
             Act := First_Entity (Inst);
             while Present (Act) loop
-               if Ekind (Act) = E_Package then
+               if Ekind (Act) = E_Package
+                 and then Declared_In_Actual (Act)
+               then
+                  return True;
+               end if;
 
-                  --  Check for end of actuals list
-
-                  if Renamed_Object (Act) = Inst then
-                     return False;
-
-                  elsif Present (Associated_Formal_Package (Act))
-                    and then Renamed_Object (Act) = Scop
-                  then
-                     --  Entity comes from (instance of) formal package
-
-                     return True;
-
-                  else
-                     Next_Entity (Act);
-                  end if;
-
-               else
-                  Next_Entity (Act);
-               end if;
+               Next_Entity (Act);
             end loop;
 
             return False;

Reply via email to