[Ada] Spurious error in use of homograph of type name in predicate

Message ID 20171009200009.GA43529@adacore.com
State New
Headers show
  • [Ada] Spurious error in use of homograph of type name in predicate
Related show

Commit Message

Pierre-Marie de Rodat Oct. 9, 2017, 8 p.m.
This patch fixes a spurious error in an expression for a dynamic predicate,
when the name of (a homograph of) the type to which the predicate applies
is used in a context where the name cannot denote a current occurrence.

The following must compile quietly:

   gcc -c conv.ads

with Typ; use Typ;
package Conv  with SPARK_Mode is
   type U is new Typ.U with record
      X : Integer;
   end record
     with Dynamic_Predicate => Typ.U(U).Get > 0;
end Conv;
package Typ is
   type U is tagged private;
   function Get (V : U) return Integer;
   type U is tagged record
      Y : Integer;
   end record;

   function Get (V : U) return Integer is (V.Y);
end Typ;

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

2017-10-09  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Replace_Type_Ref): In the expression for a dynamic
	predicate, do not replace an identifier that matches the type if the
	identifier is a selector in a selected component, because this
	indicates a reference to some homograph of the type itself, and  not to
	the current occurence in the predicate.


Index: sem_ch13.adb
--- sem_ch13.adb	(revision 253546)
+++ sem_ch13.adb	(working copy)
@@ -4415,15 +4415,6 @@ 
             if Present (Default_Element) then
                Analyze (Default_Element);
-               if Is_Entity_Name (Default_Element)
-                 and then not Covers (Entity (Default_Element), Ret_Type)
-                 and then False
-               then
-                  Illegal_Indexing
-                    ("wrong return type for indexing function");
-                  return;
-               end if;
             end if;
             --  For variable_indexing the return type must be a reference type
@@ -12670,10 +12661,18 @@ 
                return Skip;
-            --  Otherwise do the replacement and we are done with this node
+            --  Otherwise do the replacement if this is not a qualified
+            --  reference to a homograph of the type itself. Note that the
+            --  current instance could not appear in such a context, e.g.
+            --  the prefix of a type conversion.
-               Replace_Type_Reference (N);
+               if Nkind (Parent (N)) /= N_Selected_Component
+                 or else N /= Selector_Name (Parent (N))
+               then
+                  Replace_Type_Reference (N);
+               end if;
                return Skip;
             end if;
@@ -12682,7 +12681,7 @@ 
          elsif Nkind (N) = N_Selected_Component then
-            --  If selector name is not our type, keeping going (we might still
+            --  If selector name is not our type, keep going (we might still
             --  have an occurrence of the type in the prefix).
             if Nkind (Selector_Name (N)) /= N_Identifier