diff mbox

[Ada] The GNAT attribute 'Img can be renamed as a function.

Message ID 20130708075057.GA1580@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet July 8, 2013, 7:50 a.m. UTC 
This patch treats the GNAT-specific 'Img attribute as a callable entity which
therefore can be renamed as a function.  The prefix of the attribute reference
is an object rather than a subtype, and it is not evaluated at the point of the
renaming declaration.

Executing the following :

   gnatmake -q inst
   inst

must yield:

    12345
    456
   F2 =  456, Flag = TRUE
   F2 =  789, Flag = FALSE

---
with Text_IO; use Text_IO;
procedure Inst is
   generic
      with function F return String;
   procedure Gen;
   procedure Gen is begin
      Put_Line (F);
   end Gen;

   V : Integer;
   procedure Inst_Img is new Gen (V'Img);

   Table : array (Boolean) of Integer := (123, 456);
   Flag : Boolean := False;
   
   function F2 return String;
   function F2 return String renames Table(Flag)'Img;

begin
   V := 12345;
   Inst_Img;

   Table (False) := 789;
   Flag := True;

   Put_Line (Table (Flag)'Img);
   Put_Line ("F2 = " & F2 & ", Flag = " & Boolean'Image (Flag));

   Flag := False;
   Put_Line ("F2 = " & F2 & ", Flag = " & Boolean'Image (Flag));
end Inst;

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

2013-07-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Attribute_Renaming): Treat 'Img as an attribute
	that can be renamed as a function.
diff mbox

Patch

Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb	(revision 200757)
+++ sem_ch8.adb	(working copy)
@@ -3318,12 +3318,14 @@ 
 
       --  This procedure is called in the context of subprogram renaming, and
       --  thus the attribute must be one that is a subprogram. All of those
-      --  have at least one formal parameter, with the singular exception of
-      --  AST_Entry (which is a real oddity, it is odd that this can be renamed
-      --  at all!)
+      --  have at least one formal parameter, with the exceptions of AST_Entry
+      --  (which is a real oddity, it is odd that this can be renamed at all!)
+      --  and the GNAT attribute 'Img, which GNAT treats as renameable.
 
       if not Is_Non_Empty_List (Parameter_Specifications (Spec)) then
-         if Aname /= Name_AST_Entry then
+         if Aname /= Name_AST_Entry
+           and then Aname /= Name_Img
+         then
             Error_Msg_N
               ("subprogram renaming an attribute must have formals", N);
             return;
@@ -3493,11 +3495,21 @@ 
         and then Etype (Nam) /= RTE (RE_AST_Handler)
       then
          declare
-            P : constant Entity_Id := Prefix (Nam);
+            P : constant Node_Id := Prefix (Nam);
 
          begin
-            Find_Type (P);
+            --  The prefix of 'Img is an object that is evaluated for
+            --  each call of the function that renames it.
 
+            if Aname = Name_Img then
+               Preanalyze_And_Resolve (P);
+
+            --  For all other attribute renamings, the prefix is a subtype.
+
+            else
+               Find_Type (P);
+            end if;
+
             if Is_Tagged_Type (Etype (P)) then
                Ensure_Freeze_Node (Etype (P));
                Append_Freeze_Action (Etype (P), Body_Node);