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 <[email protected]>
* sem_ch8.adb (Attribute_Renaming): Treat 'Img as an attribute
that can be renamed as a function.
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);
