[Ada] Handling of implicit dereferences in generic units.

Message ID 20100614092809.GA30044@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet June 14, 2010, 9:28 a.m.
The front-end materializes dereferences whenever needed, to simplify access
checks. Explicit dereferences should not be inserted in generic units, because
the tree for a nested generic can become inconsistent, and access checks are
not generated for them in any case. The dereference will be recreated in any
subsequent instance of the generic unit.

The following must compile quietly:

procedure deref  is
   package Sync is
      type Synchronizer is access procedure (Data : in Integer);

         type Data_Type is private;
      package Data_Utility_Generic is
         procedure Synchronize (Data : in Data_Type);
      end Data_Utility_Generic;
   end Sync;

   package body Sync is
      The_Synchronizer : Synchronizer;

      package body Data_Utility_Generic is
         procedure Synchronize (Data : in Data_Type) is
             The_Synchronizer (Data   => 15);
         end Synchronize;

      end Data_Utility_Generic;
   end Sync;
      type buffer_data is private;
   package complicated_generic is
   end complicated_generic;

   package body complicated_generic is
      package Actual_Sync is new Sync.Data_Utility_Generic (buffer_data);
   end complicated_generic;

end deref;

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

2010-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Save_References): If an identifier has been rewritten
	during analysis as an explicit dereference, keep the reference implicit
	in the generic, but preserve the entity if global. This prevents
	malformed generic trees in the presence of some nested generics.


Index: sem_ch12.adb
--- sem_ch12.adb	(revision 160705)
+++ sem_ch12.adb	(working copy)
@@ -4848,8 +4848,13 @@ 
       --  To detect this case we have to rescan the list of formals, which
       --  is usually short enough to ignore the resulting inefficiency.
+      -----------------------------
+      -- Denotes_Previous_Actual --
+      -----------------------------
       function Denotes_Previous_Actual (Typ : Entity_Id) return Boolean is
          Prev : Entity_Id;
          Prev := First_Entity (Instance);
          while Present (Prev) loop
@@ -4859,12 +4864,15 @@ 
               and then Entity (Subtype_Indication (Parent (Prev))) = Typ
                return True;
             elsif Prev = E then
                return False;
                Next_Entity (Prev);
             end if;
          end loop;
          return False;
       end Denotes_Previous_Actual;
@@ -5874,7 +5882,7 @@ 
          --  If we are not instantiating, then this is where we load and
          --  analyze subunits, i.e. at the point where the stub occurs. A
-         --  more permissible system might defer this analysis to the point
+         --  more permissive system might defer this analysis to the point
          --  of instantiation, but this seems to complicated for now.
          if not Instantiating then
@@ -10480,10 +10488,18 @@ 
                  (Private_Declarations (Specification (Decl)));
+            --  Previous non-generic bodies may contain instances as well
             elsif Nkind (Decl) = N_Package_Body
               and then Ekind (Corresponding_Spec (Decl)) /= E_Generic_Package
                Collect_Previous_Instances (Declarations (Decl));
+            elsif Nkind (Decl) = N_Subprogram_Body
+              and then not Acts_As_Spec (Decl)
+              and then not Is_Generic_Subprogram (Corresponding_Spec (Decl))
+            then
+               Collect_Previous_Instances (Declarations (Decl));
             end if;
             Next (Decl);
@@ -12023,18 +12039,17 @@ 
                elsif Nkind (N2) = N_Explicit_Dereference then
                   --  An identifier is rewritten as a dereference if it is the
-                  --  prefix in an implicit dereference.
+                  --  prefix in an implicit dereference (call or attribute).
+                  --  The analysis of an instantiation will expand the node
+                  --  again, so we preserve the original tree but link it to
+                  --  the resolved entity in case it is global.
-                  --  Check whether corresponding entity in prefix is global
                   if Is_Entity_Name (Prefix (N2))
                     and then Present (Entity (Prefix (N2)))
                     and then Is_Global (Entity (Prefix (N2)))
-                     Rewrite (N,
-                       Make_Explicit_Dereference (Loc,
-                          Prefix =>
-                            New_Occurrence_Of (Entity (Prefix (N2)), Loc)));
+                     Set_Associated_Node (N, Prefix (N2));
                   elsif Nkind (Prefix (N2)) = N_Function_Call
                     and then Is_Global (Entity (Name (Prefix (N2))))