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;
