From patchwork Tue Oct  5 10:07:48 2010
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: [Ada] Prefix of 'Address attribute
From: Arnaud Charlet <charlet@adacore.com>
X-Patchwork-Id: 66786
Message-Id: <20101005100748.GA31085@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Ed Schonberg <schonberg@adacore.com>
Date: Tue, 5 Oct 2010 12:07:48 +0200

The prefix of certain attributes references  suvh as 'Address and 'Access is
never interpreted as a function call.  This rule was not properly enforced
when the prefix was an explicit dereference of an access_to_function value.

The following must compile and execute quietly:

with System; use System;
with yyy; use yyy;
procedure Addr is
begin
   if Func'Address /= Func_Addr then
      raise Program_Error;
   end if;

   if Proc'Address /= Proc_Addr then
      raise Program_Error;
   end if;
end;

---
with System; use System;
package Yyy is
   procedure Proc (Param : in Integer);
   function Func  (Param : in Integer) return Integer;

   type Proc_Ptr_T is access procedure (Param : in Integer);
   type Func_Ptr_T is access function (Param : in Integer) return Integer;

   Proc_Ptr : Proc_Ptr_T := Proc'Access;
   Func_Ptr : Func_Ptr_T := Func'Access;

   Proc_Addr : System.Address := Proc_Ptr.all'Address;
   Func_Addr : System.Address := Func_Ptr.all'Address;
end;
---
package body Yyy is

   procedure Proc (Param : in Integer) is begin null; end;
   function Func  (Param : in Integer) return Integer is
   begin
      return 1;
   end;
end;

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

2010-10-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Check_Parameterless_Call): If the prefix of 'Address is
	an explicit dereference of an access to function, the prefix is not
	interpreted as a parameterless call.

Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 164940)
+++ sem_res.adb	(working copy)
@@ -1011,6 +1011,17 @@ package body Sem_Res is
          It  : Interp;
 
       begin
+         --  if the context is an attribute reference that can apply to
+         --  functions, this is never a parameterless call. (RM 4.1.4 (6))
+
+         if Nkind (Parent (N)) = N_Attribute_Reference
+            and then (Attribute_Name (Parent (N)) = Name_Address
+              or else Attribute_Name (Parent (N)) = Name_Code_Address
+              or else Attribute_Name (Parent (N)) = Name_Access)
+         then
+            return False;
+         end if;
+
          if not Is_Overloaded (N) then
             return
               Ekind (Etype (N)) = E_Subprogram_Type
@@ -1070,7 +1081,7 @@ package body Sem_Res is
       --  If the entity is the name of an operator, it cannot be a call because
       --  operators cannot have default parameters. In this case, this must be
       --  a string whose contents coincide with an operator name. Set the kind
-      --  of the node appropriately and reanalyze.
+      --  of the node appropriately.
 
       if (Is_Entity_Name (N)
             and then Nkind (N) /= N_Operator_Symbol