diff mbox

[Ada] Spurious error in instantiation of formal package with attribute

Message ID 20151020100028.GA29803@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 20, 2015, 10 a.m. UTC 
When verifying that a function that is an actual of a formal package matches
the corresponding function in the corresponding actual package, functions
given by attributes must be handled specially because each of them ends up
renaming a different generated body, and we must check that the attribute
references themselves match.

No short example available.

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

2015-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Same_Instantiated_Function): New predicate in
	Check_Formal_Package_Instance, used to verify that the formal
	and the actual of an actual package match when both are functions
	given as attribute references.
diff mbox

Patch

Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 229023)
+++ sem_ch12.adb	(working copy)
@@ -5759,6 +5759,11 @@ 
       --  same entity we may have to traverse several definitions to recover
       --  the ultimate entity that they refer to.
 
+      function Same_Instantiated_Function (E1, E2 : Entity_Id) return Boolean;
+      --  The formal and the actual must be identical, but if both are
+      --  given by attributes they end up renaming different generated bodies,
+      --  and we must verify that the attributes themselves match.
+
       function Same_Instantiated_Variable (E1, E2 : Entity_Id) return Boolean;
       --  Similarly, if the formal comes from a nested formal package, the
       --  actual may designate the formal through multiple renamings, which
@@ -5834,6 +5839,35 @@ 
       end Same_Instantiated_Constant;
 
       --------------------------------
+      -- Same_Instantiated_Function --
+      --------------------------------
+
+      function Same_Instantiated_Function
+        (E1, E2 : Entity_Id) return Boolean
+      is
+         U1, U2 : Node_Id;
+      begin
+         if Alias (E1) = Alias (E2) then
+            return True;
+
+         elsif Present (Alias (E2)) then
+            U1 := Original_Node (Unit_Declaration_Node (E1));
+            U2 := Original_Node (Unit_Declaration_Node (Alias (E2)));
+
+            return Nkind (U1) = N_Subprogram_Renaming_Declaration
+              and then Nkind (Name (U1)) = N_Attribute_Reference
+
+              and then Nkind (U2) = N_Subprogram_Renaming_Declaration
+              and then Nkind (Name (U2)) = N_Attribute_Reference
+
+              and then
+                Attribute_Name (Name (U1)) = Attribute_Name (Name (U2));
+         else
+            return False;
+         end if;
+      end Same_Instantiated_Function;
+
+      --------------------------------
       -- Same_Instantiated_Variable --
       --------------------------------
 
@@ -6050,7 +6084,8 @@ 
 
             else
                Check_Mismatch
-                 (Ekind (E2) /= Ekind (E1) or else (Alias (E1)) /= Alias (E2));
+                 (Ekind (E2) /= Ekind (E1)
+                    or else not Same_Instantiated_Function (E1, E2));
             end if;
 
          else