sem_ch3.adb (Derive_Subprogram): If the inherited subprogram is a primitive equality...

2009-06-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Derive_Subprogram): If the inherited subprogram is a
	primitive equality include it with its source name even if the
	operation is currently invisible, to make sure that the corresponding
	slot in the dispatch table is reserved for the internal equality
	subsequently generated during expansion.

From-SVN: r148834

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7b55a040e37beef12180cd22cb0db5218d7fc6e9..69ea312679496f9c962bcdec6b57a3bc355de70f 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2009-06-23  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Derive_Subprogram): If the inherited subprogram is a
+       primitive equality include it with its source name even if the
+       operation is currently invisible, to make sure that the corresponding
+       slot in the dispatch table is reserved for the internal equality
+       subsequently generated during expansion.
+
 2009-06-23  Matthew Gingell  <gingell@adacore.com>
 
        * Makefile.rtl, a-stwiha.adb: Add a-stwiha.adb back.

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 47616825e35929c4d6cec7bc813431e0a0f846aa..df1a5002a40b319e1919d1f29643f7b801a60e86 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -12034,6 +12034,26 @@ package body Sem_Ch3 is
       then
          Set_Derived_Name;
 
+      --  An inherited dispatching equality will be overridden by an internally
+      --  generated one, or by an explicit one, so preserve its name and thus
+      --  its entry in the dispatch table. Otherwise, if Parent_Subp is a
+      --  private operation it may become invisible if the full view has
+      --  progenitors, and the dispatch table will be malformed.
+      --  We check that the type is limited to handle the anomalous declaration
+      --  of Limited_Controlled, which is derived from a non-limited type, and
+      --  which is handled specially elsewhere as well.
+
+      elsif Chars (Parent_Subp) = Name_Op_Eq
+        and then Is_Dispatching_Operation (Parent_Subp)
+        and then Etype (Parent_Subp) = Standard_Boolean
+        and then
+          not Is_Limited_Type (Etype (First_Formal (Parent_Subp)))
+        and then
+          Etype (First_Formal (Parent_Subp))
+          = Etype (Next_Formal (First_Formal (Parent_Subp)))
+      then
+         Set_Derived_Name;
+
       --  If parent is hidden, this can be a regular derivation if the
       --  parent is immediately visible in a non-instantiating context,
       --  or if we are in the private part of an instance. This test
@@ -12065,7 +12085,7 @@ package body Sem_Ch3 is
       elsif Parent_Overrides_Interface_Primitive then
          Set_Derived_Name;
 
-      --  The type is inheriting a private operation, so enter
+      --  Otherwise, the type is inheriting a private operation, so enter
       --  it with a special name so it can't be overridden.
 
       else