2011-08-05 Javier Miranda <miranda@adacore.com>

	* exp_disp.adb (Set_All_DT_Position): Cleanup code and improve support
	for renamings of predefined primitives.
	(In_Predef_Prims_DT): New subprogram.

2011-08-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb, sem_util.ads (Check_Implicit_Dereference): If a
	possible interpretation of name is a reference type, add an
	interpretation that is the designated type of the reference
	discriminant of that type.
	* sem_res.adb (resolve): If the interpretation imposed by context is an
	implicit dereference, rewrite the node as the deference of the
	reference discriminant.
	* sem_ch3.adb (Analyze_Subtype_Declaration, Build_Derived_Record_Type,
	Build_Discriminated_Subtype): Inherit Has_Implicit_Dereference from
	parent type or base type.
	* sem_ch4.adb (Process_Indexed_Component,
	Process_Overloaded_Indexed_Component, Indicate_Name_And_Type,
	Analyze_Overloaded_Selected_Component, Analyze_Selected_Component):
	Check for implicit dereference.
	(List_Operand_Interps): Indicate when an implicit dereference is
	ambiguous.
	* sem_ch8.adb (Find_Direct_Name): Check for implicit dereference.

2011-08-05  Thomas Quinot  <quinot@adacore.com>

	* scos.ads: Update documentation of SCO table. Pragma statements can now
	be marked as disabled (using 'p' instead of 'P' as the statement kind).
	* par_sco.ads, par_sco.adb: Implement the above change.
	(Process_Decisions_Defer): Generate a P decision for the first parameter
	of a dyadic pragma Debug.
	* sem_prag.adb (Analyze_Pragma, case Debug): Mark pragma as enabled if
	necessary.
	* put_scos.adb: Code simplification based on above change.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177442 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 59 insertions, 13 deletions

diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index a577a2512ac..10c0d799e7e 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -7722,11 +7722,59 @@ package body Exp_Disp is
 
    procedure Set_All_DT_Position (Typ : Entity_Id) is
 
+      function In_Predef_Prims_DT (Prim : Entity_Id) return Boolean;
+      --  Returns True if Prim is located in the dispatch table of
+      --  predefined primitives
+
       procedure Validate_Position (Prim : Entity_Id);
       --  Check that the position assigned to Prim is completely safe
       --  (it has not been assigned to a previously defined primitive
       --   operation of Typ)
 
+      ------------------------
+      -- In_Predef_Prims_DT --
+      ------------------------
+
+      function In_Predef_Prims_DT (Prim : Entity_Id) return Boolean is
+         E : Entity_Id;
+
+      begin
+         --  Predefined primitives
+
+         if Is_Predefined_Dispatching_Operation (Prim) then
+            return True;
+
+         --  Renamings of predefined primitives
+
+         elsif Present (Alias (Prim))
+           and then Is_Predefined_Dispatching_Operation (Ultimate_Alias (Prim))
+         then
+            if Chars (Ultimate_Alias (Prim)) /= Name_Op_Eq then
+               return True;
+
+            --  User-defined renamings of predefined equality have their own
+            --  slot in the primary dispatch table
+
+            else
+               E := Prim;
+               while Present (Alias (E)) loop
+                  if Comes_From_Source (E) then
+                     return False;
+                  end if;
+
+                  E := Alias (E);
+               end loop;
+
+               return not Comes_From_Source (E);
+            end if;
+
+         --  User-defined primitives
+
+         else
+            return False;
+         end if;
+      end In_Predef_Prims_DT;
+
       -----------------------
       -- Validate_Position --
       -----------------------
@@ -7850,10 +7898,7 @@ package body Exp_Disp is
 
          --  Predefined primitives have a separate dispatch table
 
-         if not (Is_Predefined_Dispatching_Operation (Prim)
-                   or else
-                 Is_Predefined_Dispatching_Alias (Prim))
-         then
+         if not In_Predef_Prims_DT (Prim) then
             Count_Prim := Count_Prim + 1;
          end if;
 
@@ -7978,12 +8023,14 @@ package body Exp_Disp is
             --  Predefined primitives have a separate table and all its
             --  entries are at predefined fixed positions.
 
-            if Is_Predefined_Dispatching_Operation (Prim) then
-               Set_DT_Position (Prim, Default_Prim_Op_Position (Prim));
+            if In_Predef_Prims_DT (Prim) then
+               if Is_Predefined_Dispatching_Operation (Prim) then
+                  Set_DT_Position (Prim, Default_Prim_Op_Position (Prim));
 
-            elsif Is_Predefined_Dispatching_Alias (Prim) then
-               Set_DT_Position (Prim,
-                 Default_Prim_Op_Position (Ultimate_Alias (Prim)));
+               else pragma Assert (Present (Alias (Prim)));
+                  Set_DT_Position (Prim,
+                    Default_Prim_Op_Position (Ultimate_Alias (Prim)));
+               end if;
 
             --  Overriding primitives of ancestor abstract interfaces
 
@@ -8124,8 +8171,7 @@ package body Exp_Disp is
 
          --  Calculate real size of the dispatch table
 
-         if not (Is_Predefined_Dispatching_Operation (Prim)
-                   or else Is_Predefined_Dispatching_Alias (Prim))
+         if not In_Predef_Prims_DT (Prim)
            and then UI_To_Int (DT_Position (Prim)) > DT_Length
          then
             DT_Length := UI_To_Int (DT_Position (Prim));
@@ -8134,8 +8180,8 @@ package body Exp_Disp is
          --  Ensure that the assigned position to non-predefined
          --  dispatching operations in the dispatch table is correct.
 
-         if not (Is_Predefined_Dispatching_Operation (Prim)
-                   or else Is_Predefined_Dispatching_Alias (Prim))
+         if not Is_Predefined_Dispatching_Operation (Prim)
+           and then not Is_Predefined_Dispatching_Alias (Prim)
          then
             Validate_Position (Prim);
          end if;