===================================================================
@@ -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;
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 <schonberg@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.