This change fixes a defect in the visibility rules whereby a root library
unit that appears indirectly in the closure is erroneously treated as
visible if referred to using an expanded name with prefix Standard.
Root library units must be treated no different than child units for
visibility purposes, as they are all children of predefined package Standard.
The following compilation must be rejected with the indicated error message:
$ gcc -c root_visibility.adb
root_visibility.adb:3:18: "U1" is not a visible entity of "Standard"
with U2;
procedure Root_Visibility is
Self : Standard.U1.Address;
begin
Self := 123;
end;
with U1;
package U2 is end;
package U1 is
type Address is mod 2**32;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-01-03 Thomas Quinot <qui...@adacore.com>
* sem_ch7.adb, sem_ch10.adb, einfo.adb, einfo.ads, sem_ch12.adb,
rtsfind.adb, sem_elab.adb, sem_ch4.adb, sem_ch8.adb
(Einfo.Is_Visible_Child_Unit, Einfo.Set_Is_Visible_Child_Unit):
Rename to Is_Visible_Lib_Unit, Set_Is_Visible_Lib_Unit, and
update spec accordingly (now also applies to root library units).
(Sem_Ch10.Analyze_Subunit.Analyze_Subunit_Context): Toggle above flag
on root library units, not only child units.
(Sem_Ch10.Install[_Limited]_Withed_Unit): Same.
(Sem_Ch10.Remove_Unit_From_Visibility): Reset Is_Visible_Lib_Unit
even for root library units.
(Sem_Ch8.Find_Expanded_Name): A selected component form whose prefix is
Standard is an expanded name for a root library unit.
Index: sem_ch7.adb
===================================================================
--- sem_ch7.adb (revision 194841)
+++ sem_ch7.adb (working copy)
@@ -2253,7 +2253,7 @@
if Is_Child_Unit (Id) then
Set_Is_Potentially_Use_Visible
- (Id, Is_Visible_Child_Unit (Id));
+ (Id, Is_Visible_Lib_Unit (Id));
else
Set_Is_Potentially_Use_Visible (Id);
end if;
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb (revision 194841)
+++ sem_ch10.adb (working copy)
@@ -2040,9 +2040,15 @@
end if;
Unit_Name := Entity (Name (Item));
- while Is_Child_Unit (Unit_Name) loop
- Set_Is_Visible_Child_Unit (Unit_Name);
+ loop
+ Set_Is_Visible_Lib_Unit (Unit_Name);
+ exit when Scope (Unit_Name) = Standard_Standard;
Unit_Name := Scope (Unit_Name);
+
+ if No (Unit_Name) then
+ Check_Error_Detected;
+ return;
+ end if;
end loop;
if not Is_Immediately_Visible (Unit_Name) then
@@ -2083,8 +2089,9 @@
and then not Error_Posted (Item)
then
Unit_Name := Entity (Name (Item));
- while Is_Child_Unit (Unit_Name) loop
- Set_Is_Visible_Child_Unit (Unit_Name, False);
+ loop
+ Set_Is_Visible_Lib_Unit (Unit_Name, False);
+ exit when Scope (Unit_Name) = Standard_Standard;
Unit_Name := Scope (Unit_Name);
end loop;
@@ -2131,7 +2138,7 @@
E := First_Entity (Current_Scope);
while Present (E) loop
if not Is_Child_Unit (E)
- or else Is_Visible_Child_Unit (E)
+ or else Is_Visible_Lib_Unit (E)
then
Set_Is_Immediately_Visible (E);
end if;
@@ -2296,11 +2303,9 @@
C : Entity_Id;
begin
C := Current_Scope;
- while Present (C)
- and then Is_Child_Unit (C)
- loop
+ while Present (C) and then C /= Standard_Standard loop
Set_Is_Immediately_Visible (C);
- Set_Is_Visible_Child_Unit (C);
+ Set_Is_Visible_Lib_Unit (C);
C := Scope (C);
end loop;
end;
@@ -4210,7 +4215,7 @@
end In_Context;
begin
- Set_Is_Visible_Child_Unit (Id, In_Context);
+ Set_Is_Visible_Lib_Unit (Id, In_Context);
end;
end if;
end if;
@@ -4788,7 +4793,7 @@
if Analyzed (P_Unit)
and then
(Is_Immediately_Visible (P)
- or else (Is_Child_Package and then Is_Visible_Child_Unit (P)))
+ or else (Is_Child_Package and then Is_Visible_Lib_Unit (P)))
then
-- The presence of both the limited and the analyzed nonlimited view
@@ -4852,10 +4857,10 @@
Set_Ekind (P, E_Package);
Set_Etype (P, Standard_Void_Type);
Set_Scope (P, Standard_Standard);
+ Set_Is_Visible_Lib_Unit (P);
if Is_Child_Package then
Set_Is_Child_Unit (P);
- Set_Is_Visible_Child_Unit (P);
Set_Scope (P, Defining_Entity (Unit (Parent_Spec (P_Unit))));
end if;
@@ -5101,7 +5106,7 @@
Error_Msg_N
("instantiation depends on itself", Name (With_Clause));
- elsif not Is_Visible_Child_Unit (Uname) then
+ elsif not Is_Visible_Lib_Unit (Uname) then
-- Abandon processing in case of previous errors
@@ -5110,7 +5115,7 @@
return;
end if;
- Set_Is_Visible_Child_Unit (Uname);
+ Set_Is_Visible_Lib_Unit (Uname);
-- If the child unit appears in the context of its parent, it is
-- immediately visible.
@@ -5125,7 +5130,7 @@
-- Set flag as well on the visible entity that denotes the
-- instance, which renames the current one.
- Set_Is_Visible_Child_Unit
+ Set_Is_Visible_Lib_Unit
(Related_Instance
(Defining_Entity (Unit (Library_Unit (With_Clause)))));
end if;
@@ -5141,6 +5146,7 @@
end if;
elsif not Is_Immediately_Visible (Uname) then
+ Set_Is_Visible_Lib_Unit (Uname);
if not Private_Present (With_Clause)
or else Private_With_OK
then
@@ -5167,7 +5173,7 @@
-- not apply the check to the Standard package itself.
if Is_Child_Unit (Uname)
- and then Is_Visible_Child_Unit (Uname)
+ and then Is_Visible_Lib_Unit (Uname)
and then Ada_Version >= Ada_2005
then
declare
@@ -5185,7 +5191,7 @@
Decl2 := Unit_Declaration_Node (P2);
if Is_Child_Unit (U2)
- and then Is_Visible_Child_Unit (U2)
+ and then Is_Visible_Lib_Unit (U2)
then
if Is_Generic_Instance (P)
and then Nkind (Decl1) = N_Package_Declaration
@@ -6220,8 +6226,6 @@
---------------------------------
procedure Remove_Unit_From_Visibility (Unit_Name : Entity_Id) is
- P : constant Entity_Id := Scope (Unit_Name);
-
begin
if Debug_Flag_I then
Write_Str ("remove unit ");
@@ -6230,10 +6234,7 @@
Write_Eol;
end if;
- if P /= Standard_Standard then
- Set_Is_Visible_Child_Unit (Unit_Name, False);
- end if;
-
+ Set_Is_Visible_Lib_Unit (Unit_Name, False);
Set_Is_Potentially_Use_Visible (Unit_Name, False);
Set_Is_Immediately_Visible (Unit_Name, False);
Index: einfo.adb
===================================================================
--- einfo.adb (revision 194842)
+++ einfo.adb (working copy)
@@ -375,7 +375,7 @@
-- No_Return Flag113
-- Delay_Cleanups Flag114
-- Never_Set_In_Source Flag115
- -- Is_Visible_Child_Unit Flag116
+ -- Is_Visible_Lib_Unit Flag116
-- Is_Unchecked_Union Flag117
-- Is_For_Access_Subtype Flag118
-- Has_Convention_Pragma Flag119
@@ -2175,11 +2175,10 @@
return Flag127 (Id);
end Is_Valued_Procedure;
- function Is_Visible_Child_Unit (Id : E) return B is
+ function Is_Visible_Lib_Unit (Id : E) return B is
begin
- pragma Assert (Is_Child_Unit (Id));
return Flag116 (Id);
- end Is_Visible_Child_Unit;
+ end Is_Visible_Lib_Unit;
function Is_Visible_Formal (Id : E) return B is
begin
@@ -4736,11 +4735,10 @@
Set_Flag127 (Id, V);
end Set_Is_Valued_Procedure;
- procedure Set_Is_Visible_Child_Unit (Id : E; V : B := True) is
+ procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True) is
begin
- pragma Assert (Is_Child_Unit (Id));
Set_Flag116 (Id, V);
- end Set_Is_Visible_Child_Unit;
+ end Set_Is_Visible_Lib_Unit;
procedure Set_Is_Visible_Formal (Id : E; V : B := True) is
begin
@@ -7602,7 +7600,7 @@
W ("Is_Unsigned_Type", Flag144 (Id));
W ("Is_VMS_Exception", Flag133 (Id));
W ("Is_Valued_Procedure", Flag127 (Id));
- W ("Is_Visible_Child_Unit", Flag116 (Id));
+ W ("Is_Visible_Lib_Unit", Flag116 (Id));
W ("Is_Visible_Formal", Flag206 (Id));
W ("Is_Volatile", Flag16 (Id));
W ("Itype_Printed", Flag202 (Id));
Index: einfo.ads
===================================================================
--- einfo.ads (revision 194841)
+++ einfo.ads (working copy)
@@ -2856,11 +2856,11 @@
-- Defined in procedure entities. Set if an Import_Valued_Procedure
-- or Export_Valued_Procedure pragma applies to the procedure entity.
--- Is_Visible_Child_Unit (Flag116)
--- Defined in compilation units that are child units. Once compiled,
--- child units remain chained to the entities in the parent unit, and
--- a separate flag must be used to indicate whether the names are
--- visible by selected notation, or not.
+-- Is_Visible_Lib_Unit (Flag116)
+-- Defined in all (root or child) library unit entities. Once compiled,
+-- library units remain chained to the entities in the parent scope, and
+-- a separate flag must be used to indicate whether the names are visible
+-- by selected notation, or not.
-- Is_Visible_Formal (Flag206)
-- Defined in all entities. Set True for instances of the formals of a
@@ -5310,7 +5310,7 @@
-- Is_Private_Primitive (Flag245) (non-generic case only)
-- Is_Pure (Flag44)
-- Is_Thunk (Flag225)
- -- Is_Visible_Child_Unit (Flag116)
+ -- Is_Visible_Lib_Unit (Flag116)
-- Needs_No_Actuals (Flag22)
-- Requires_Overriding (Flag213) (non-generic case only)
-- Return_Present (Flag54)
@@ -5490,7 +5490,7 @@
-- In_Use (Flag8)
-- Is_Instantiated (Flag126)
-- Is_Private_Descendant (Flag53)
- -- Is_Visible_Child_Unit (Flag116)
+ -- Is_Visible_Lib_Unit (Flag116)
-- Renamed_In_Spec (Flag231) (non-generic case only)
-- Static_Elaboration_Desired (Flag77) (non-generic case only)
-- Is_Wrapper_Package (synth) (non-generic case only)
@@ -5580,7 +5580,7 @@
-- Is_Pure (Flag44)
-- Is_Thunk (Flag225)
-- Is_Valued_Procedure (Flag127)
- -- Is_Visible_Child_Unit (Flag116)
+ -- Is_Visible_Lib_Unit (Flag116)
-- Needs_No_Actuals (Flag22)
-- No_Return (Flag113)
-- Requires_Overriding (Flag213) (non-generic case only)
@@ -6310,7 +6310,7 @@
function Is_Unsigned_Type (Id : E) return B;
function Is_VMS_Exception (Id : E) return B;
function Is_Valued_Procedure (Id : E) return B;
- function Is_Visible_Child_Unit (Id : E) return B;
+ function Is_Visible_Lib_Unit (Id : E) return B;
function Is_Visible_Formal (Id : E) return B;
function Is_Volatile (Id : E) return B;
function Itype_Printed (Id : E) return B;
@@ -6908,7 +6908,7 @@
procedure Set_Is_Unsigned_Type (Id : E; V : B := True);
procedure Set_Is_VMS_Exception (Id : E; V : B := True);
procedure Set_Is_Valued_Procedure (Id : E; V : B := True);
- procedure Set_Is_Visible_Child_Unit (Id : E; V : B := True);
+ procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True);
procedure Set_Is_Visible_Formal (Id : E; V : B := True);
procedure Set_Is_Volatile (Id : E; V : B := True);
procedure Set_Itype_Printed (Id : E; V : B := True);
@@ -7629,7 +7629,7 @@
pragma Inline (Is_Unsigned_Type);
pragma Inline (Is_VMS_Exception);
pragma Inline (Is_Valued_Procedure);
- pragma Inline (Is_Visible_Child_Unit);
+ pragma Inline (Is_Visible_Lib_Unit);
pragma Inline (Is_Visible_Formal);
pragma Inline (Itype_Printed);
pragma Inline (Kill_Elaboration_Checks);
@@ -8035,7 +8035,7 @@
pragma Inline (Set_Is_Unsigned_Type);
pragma Inline (Set_Is_VMS_Exception);
pragma Inline (Set_Is_Valued_Procedure);
- pragma Inline (Set_Is_Visible_Child_Unit);
+ pragma Inline (Set_Is_Visible_Lib_Unit);
pragma Inline (Set_Is_Visible_Formal);
pragma Inline (Set_Is_Volatile);
pragma Inline (Set_Itype_Printed);
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb (revision 194841)
+++ sem_ch12.adb (working copy)
@@ -5719,7 +5719,7 @@
and then Is_Child_Unit (E)
then
if Is_Child_Unit (E)
- and then not Is_Visible_Child_Unit (E)
+ and then not Is_Visible_Lib_Unit (E)
then
Error_Msg_NE
("generic child unit& is not visible", Gen_Id, E);
Index: rtsfind.adb
===================================================================
--- rtsfind.adb (revision 194841)
+++ rtsfind.adb (working copy)
@@ -1466,7 +1466,7 @@
end if;
Load_RTU (To_Load, Use_Setting => In_Use (Cunit_Entity (U)));
- Set_Is_Visible_Child_Unit (RT_Unit_Table (To_Load).Entity);
+ Set_Is_Visible_Lib_Unit (RT_Unit_Table (To_Load).Entity);
-- Prevent creation of an implicit 'with' from (for example)
-- Ada.Wide_Text_IO.Integer_IO to Ada.Text_IO.Integer_IO,
Index: sem_elab.adb
===================================================================
--- sem_elab.adb (revision 194841)
+++ sem_elab.adb (working copy)
@@ -2551,7 +2551,7 @@
-- visible, and we can set the elaboration flag.
if Is_Immediately_Visible (Scop)
- or else (Is_Child_Unit (Scop) and then Is_Visible_Child_Unit (Scop))
+ or else (Is_Child_Unit (Scop) and then Is_Visible_Lib_Unit (Scop))
then
Activate_Elaborate_All_Desirable (Call, Scop);
Set_Suppress_Elaboration_Warnings (Scop, True);
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 194841)
+++ sem_ch4.adb (working copy)
@@ -1765,7 +1765,7 @@
(Is_Immediately_Visible (Scope (DT))
or else
(Is_Child_Unit (Scope (DT))
- and then Is_Visible_Child_Unit (Scope (DT))))
+ and then Is_Visible_Lib_Unit (Scope (DT))))
then
Set_Etype (N, Available_View (DT));
@@ -6320,7 +6320,7 @@
(Is_Immediately_Visible (Scope (Typ))
or else
(Is_Child_Unit (Scope (Typ))
- and then Is_Visible_Child_Unit (Scope (Typ))))
+ and then Is_Visible_Lib_Unit (Scope (Typ))))
then
return Available_View (Typ);
else
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 194843)
+++ sem_ch8.adb (working copy)
@@ -5143,8 +5143,8 @@
end if;
if Is_New_Candidate then
- if Is_Child_Unit (Id) then
- exit when Is_Visible_Child_Unit (Id)
+ if Is_Child_Unit (Id) or else P_Name = Standard_Standard then
+ exit when Is_Visible_Lib_Unit (Id)
or else Is_Immediately_Visible (Id);
else
@@ -5334,7 +5334,7 @@
and then Is_Compilation_Unit (Homonym (P_Name))
and then
(Is_Immediately_Visible (Homonym (P_Name))
- or else Is_Visible_Child_Unit (Homonym (P_Name)))
+ or else Is_Visible_Lib_Unit (Homonym (P_Name)))
then
declare
H : constant Entity_Id := Homonym (P_Name);
@@ -7685,7 +7685,7 @@
if Is_Child_Unit (E) then
if not From_With_Type (E) then
Set_Is_Immediately_Visible (E,
- Is_Visible_Child_Unit (E) or else In_Open_Scopes (E));
+ Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E));
else
pragma Assert
@@ -7718,7 +7718,7 @@
while Present (E) loop
if Is_Child_Unit (E) then
Set_Is_Immediately_Visible (E,
- Is_Visible_Child_Unit (E) or else In_Open_Scopes (E));
+ Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E));
end if;
Next_Entity (E);
@@ -8030,7 +8030,7 @@
if not Is_Hidden (Id)
and then ((not Is_Child_Unit (Id))
- or else Is_Visible_Child_Unit (Id))
+ or else Is_Visible_Lib_Unit (Id))
then
Set_Is_Potentially_Use_Visible (Id);
@@ -8050,7 +8050,7 @@
while Present (Id) loop
if Is_Child_Unit (Id)
- and then Is_Visible_Child_Unit (Id)
+ and then Is_Visible_Lib_Unit (Id)
then
Set_Is_Potentially_Use_Visible (Id);
end if;
