Patchwork [Ada] Wrong visibility for root library unit

login
register
mail settings
Submitter Arnaud Charlet
Date Jan. 3, 2013, 10:52 a.m.
Message ID <20130103105241.GA8918@adacore.com>
Download mbox | patch
Permalink /patch/209215/
State New
Headers show

Comments

Arnaud Charlet - Jan. 3, 2013, 10:52 a.m.
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  <quinot@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.

Patch

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;