Patchwork [Ada] Avoid spurious error reported by the compiler

login
register
mail settings
Submitter Arnaud Charlet
Date July 8, 2013, 7:44 a.m.
Message ID <20130708074415.GA28739@adacore.com>
Download mbox | patch
Permalink /patch/257480/
State New
Headers show

Comments

Arnaud Charlet - July 8, 2013, 7:44 a.m.
This patch modifies the approach taken by the compiler to save/restore
the scope stack. The save routine now returns the list of entitites
which have been temporarily removed from visibility, and that list
is passed to the restore routine to restore their visibility.

This approach consumes more memory than the previous approach
but avoids latent problems caused by the previous approach.

After this patch the following test compiles silently.

package P is
   type Root_Type is abstract tagged limited record
      N : Natural;
   end record;

   type Child_Type is abstract limited new Root_Type with null record;
   type Interface_Type is limited interface;
   function F (N : Natural) return Interface_Type is abstract;
end P;

generic package P.Generic_Child_Package is
   type T is new P.Child_Type and P.Interface_Type with null record;
   overriding function F (N : in Natural) return T;
end P.Generic_Child_Package;

with P.Generic_Child_Package;
package Q is
   package Instance_Package is new P.Generic_Child_Package;

   X : Instance_Package.T := Instance_Package.F (10);
end Q;

Command: gcc -c -gnat05 q.ads

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

2013-07-08  Javier Miranda  <miranda@adacore.com>

	* sem_ch8.ad[sb] (Save_Scope_Stack): Modified to return the list
	of entities which have been temporarily removed from immediate
	visibility.
	(Restore_Scope_Stack): Modified to receive an
	additional parameter with the list of entities whose immediate
	visibility must be restored.
	* sem.adb (Do_Analyze): Use new version of
	Save_Scope_Stack/Restore_Scope_Stack
	* sem_ch12.adb (Inline_Instance_Body): Use new version of
	Save_Scope_Stack and Restore_Scope_Stack

Patch

Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 200704)
+++ sem_ch12.adb	(working copy)
@@ -4084,6 +4084,7 @@ 
       Use_Clauses  : array (1 .. Scope_Stack_Depth) of Node_Id;
       Instances    : array (1 .. Scope_Stack_Depth) of Entity_Id;
       Inner_Scopes : array (1 .. Scope_Stack_Depth) of Entity_Id;
+      List         : Elist_Id;
       Num_Inner    : Int := 0;
       N_Instances  : Int := 0;
       S            : Entity_Id;
@@ -4187,7 +4188,7 @@ 
                --  Remove entities in current scopes from visibility, so that
                --  instance body is compiled in a clean environment.
 
-               Save_Scope_Stack (Handle_Use => False);
+               List := Save_Scope_Stack (Handle_Use => False);
 
                if Is_Child_Unit (S) then
 
@@ -4261,7 +4262,7 @@ 
                end loop;
             end if;
 
-            Restore_Scope_Stack (Handle_Use => False);
+            Restore_Scope_Stack (List, Handle_Use => False);
 
             if Present (Curr_Scope)
               and then
Index: sem.adb
===================================================================
--- sem.adb	(revision 200688)
+++ sem.adb	(working copy)
@@ -1340,8 +1340,10 @@ 
       ----------------
 
       procedure Do_Analyze is
+         List : Elist_Id;
+
       begin
-         Save_Scope_Stack;
+         List := Save_Scope_Stack;
          Push_Scope (Standard_Standard);
          Scope_Suppress := Suppress_Options;
          Scope_Stack.Table
@@ -1362,7 +1364,7 @@ 
          --  Then pop entry for Standard, and pop implicit types
 
          Pop_Scope;
-         Restore_Scope_Stack;
+         Restore_Scope_Stack (List);
       end Do_Analyze;
 
       Already_Analyzed : constant Boolean := Analyzed (Comp_Unit);
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb	(revision 200705)
+++ sem_ch8.adb	(working copy)
@@ -7654,119 +7654,20 @@ 
    -- Restore_Scope_Stack --
    -------------------------
 
-   procedure Restore_Scope_Stack (Handle_Use : Boolean := True) is
-      E         : Entity_Id;
-      S         : Entity_Id;
-      Comp_Unit : Node_Id;
-      In_Child  : Boolean := False;
-      Full_Vis  : Boolean := True;
-      SS_Last   : constant Int := Scope_Stack.Last;
+   procedure Restore_Scope_Stack
+     (List       : Elist_Id;
+      Handle_Use : Boolean := True)
+   is
+      SS_Last : constant Int := Scope_Stack.Last;
+      Elmt    : Elmt_Id;
 
    begin
       --  Restore visibility of previous scope stack, if any
 
-      for J in reverse 0 .. Scope_Stack.Last loop
-         exit when  Scope_Stack.Table (J).Entity = Standard_Standard
-            or else No (Scope_Stack.Table (J).Entity);
-
-         S := Scope_Stack.Table (J).Entity;
-
-         if not Is_Hidden_Open_Scope (S) then
-
-            --  If the parent scope is hidden, its entities are hidden as
-            --  well, unless the entity is the instantiation currently
-            --  being analyzed.
-
-            if not Is_Hidden_Open_Scope (Scope (S))
-              or else not Analyzed (Parent (S))
-              or else Scope (S) = Standard_Standard
-            then
-               Set_Is_Immediately_Visible (S, True);
-            end if;
-
-            E := First_Entity (S);
-            while Present (E) loop
-               if Is_Child_Unit (E) then
-                  if not From_With_Type (E) then
-                     Set_Is_Immediately_Visible (E,
-                       Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E));
-
-                  else
-                     pragma Assert
-                       (Nkind (Parent (E)) = N_Defining_Program_Unit_Name
-                         and then
-                           Nkind (Parent (Parent (E))) =
-                                               N_Package_Specification);
-                     Set_Is_Immediately_Visible (E,
-                       Limited_View_Installed (Parent (Parent (E))));
-                  end if;
-               else
-                  Set_Is_Immediately_Visible (E, True);
-               end if;
-
-               Next_Entity (E);
-
-               if not Full_Vis and then Is_Package_Or_Generic_Package (S) then
-
-                  --  We are in the visible part of the package scope
-
-                  exit when E = First_Private_Entity (S);
-               end if;
-            end loop;
-
-            --  The visibility of child units (siblings of current compilation)
-            --  must be restored in any case. Their declarations may appear
-            --  after the private part of the parent.
-
-            if not Full_Vis then
-               while Present (E) loop
-                  if Is_Child_Unit (E) then
-                     Set_Is_Immediately_Visible (E,
-                       Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E));
-                  end if;
-
-                  Next_Entity (E);
-               end loop;
-            end if;
-         end if;
-
-         if Is_Child_Unit (S)
-            and not In_Child     --  check only for current unit
-         then
-            In_Child := True;
-
-            --  Restore visibility of parents according to whether the child
-            --  is private and whether we are in its visible part.
-
-            Comp_Unit := Parent (Unit_Declaration_Node (S));
-
-            if Nkind (Comp_Unit) = N_Compilation_Unit
-              and then Private_Present (Comp_Unit)
-            then
-               Full_Vis := True;
-
-            elsif Is_Package_Or_Generic_Package (S)
-              and then (In_Private_Part (S) or else In_Package_Body (S))
-            then
-               Full_Vis := True;
-
-            --  if S is the scope of some instance (which has already been
-            --  seen on the stack) it does not affect the visibility of
-            --  other scopes.
-
-            elsif Is_Hidden_Open_Scope (S) then
-               null;
-
-            elsif Ekind_In (S, E_Procedure, E_Function)
-              and then Has_Completion (S)
-            then
-               Full_Vis := True;
-            else
-               Full_Vis := False;
-            end if;
-         else
-            Full_Vis := True;
-         end if;
+      Elmt := First_Elmt (List);
+      while Present (Elmt) loop
+         Set_Is_Immediately_Visible (Node (Elmt));
+         Next_Elmt (Elmt);
       end loop;
 
       if SS_Last >= Scope_Stack.First
@@ -7781,11 +7682,24 @@ 
    -- Save_Scope_Stack --
    ----------------------
 
-   procedure Save_Scope_Stack (Handle_Use : Boolean := True) is
+   function Save_Scope_Stack (Handle_Use : Boolean := True) return Elist_Id is
+      Result  : constant Elist_Id := New_Elmt_List;
       E       : Entity_Id;
       S       : Entity_Id;
       SS_Last : constant Int := Scope_Stack.Last;
 
+      procedure Remove_From_Visibility (E : Entity_Id);
+      --  If E is immediately visible then append it to the result and remove
+      --  it temporarily from visibility
+
+      procedure Remove_From_Visibility (E : Entity_Id) is
+      begin
+         if Is_Immediately_Visible (E) then
+            Append_Elmt (E, Result);
+            Set_Is_Immediately_Visible (E, False);
+         end if;
+      end Remove_From_Visibility;
+
    begin
       if SS_Last >= Scope_Stack.First
         and then Scope_Stack.Table (SS_Last).Entity /= Standard_Standard
@@ -7803,16 +7717,19 @@ 
                or else No (Scope_Stack.Table (J).Entity);
 
             S := Scope_Stack.Table (J).Entity;
-            Set_Is_Immediately_Visible (S, False);
 
+            Remove_From_Visibility (S);
+
             E := First_Entity (S);
             while Present (E) loop
-               Set_Is_Immediately_Visible (E, False);
+               Remove_From_Visibility (E);
                Next_Entity (E);
             end loop;
          end loop;
 
       end if;
+
+      return Result;
    end Save_Scope_Stack;
 
    -------------
Index: sem_ch8.ads
===================================================================
--- sem_ch8.ads	(revision 200688)
+++ sem_ch8.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -148,9 +148,11 @@ 
    --  with-clause on system. N is absent when the function is called to find
    --  the visibility of implicit operators.
 
-   procedure Restore_Scope_Stack (Handle_Use : Boolean := True);
-   procedure Save_Scope_Stack (Handle_Use : Boolean := True);
-   --  These two procedures are called from Semantics, when a unit U1 is to
+   function Save_Scope_Stack (Handle_Use : Boolean := True) return Elist_Id;
+   procedure Restore_Scope_Stack
+     (List       : Elist_Id;
+      Handle_Use : Boolean := True);
+   --  These two subprograms are called from Semantics, when a unit U1 is to
    --  be compiled in the course of the compilation of another unit U2. This
    --  happens whenever Rtsfind is called. U1, the unit retrieved by Rtsfind,
    --  must be compiled in its own context, and the current scope stack
@@ -159,7 +161,9 @@ 
    --  Handle_Use indicates whether local use clauses must be removed or
    --  installed. In the case of inlining of instance bodies, the visibility
    --  handling is done fully in Inline_Instance_Body, and use clauses are
-   --  handled there.
+   --  handled there. Save_Scope_Stack returns the list of entities which have
+   --  been temporarily removed from visibility; that list must be passed to
+   --  Restore_Scope_Stack to restore their visibility.
 
    procedure Set_Use (L : List_Id);
    --  Find use clauses that are declarative items in a package declaration