If a subprogram to be inlined has a by-reference parameter, the value of the
actual must be captured in a renaming declaration to avoid an improper copy.
This was done for limited types and tagged types but not for types with by-
reference components.
The following must execute quietly:
with D2; use D2;
with Text_Io; use Text_Io;
procedure Always_Test is
generic
with procedure Action (By_Ref : By_Ref_T);
procedure Scan_G;
procedure Scan_G is
begin
Action (Data.By_Ref);
end Scan_G;
procedure Scan_Inline_Always is new Scan_G (Action_Inline_Always);
procedure Scan is new Scan_G (Action);
begin
Data := (12, (34, (Me_tagged => 46)), 78);
Scan;
Scan_Inline_Always;
end Always_Test;
---
package D2 is
type Tagged_T is tagged record Me_Tagged : Positive; end record;
type By_Ref_T is
record
Me : Positive;
Make_By_Ref : Tagged_T;
end record;
type Container_T is
record
Me_Bef : Positive;
By_Ref : By_Ref_T;
Me_After : Positive;
end record;
Data : Container_T;
procedure Action_Inline_Always (By_Ref : By_Ref_T);
pragma Inline_Always (Action_Inline_Always);
procedure Action (By_Ref : By_Ref_T);
end D2;
---
with Text_Io; use Text_Io;
with System; use System;
package body D2 is
procedure Common_Action (From : String;
Addr : System.Address) is
begin
if Addr = Data.By_Ref'Address then
null;
else
Put_Line ("FAILED");
end if;
end Common_Action;
procedure Action_Inline_Always (By_Ref : By_Ref_T) is
begin
Common_Action ("Action_Inline_Always", By_Ref'Address);
end Action_Inline_Always;
procedure Action (By_Ref : By_Ref_T) is
begin
Common_Action ("Action", By_Ref'Address);
end Action;
end D2;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-01 Ed Schonberg <[email protected]>
* exp_ch6.adb (Expand_Inlined_Call): If an actual is a by_reference
type, declare a renaming for it, not an object declaration.
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 178403)
+++ exp_ch6.adb (working copy)
@@ -4188,6 +4188,7 @@
if Ekind (F) = E_In_Parameter
and then not Is_Limited_Type (Etype (A))
and then not Is_Tagged_Type (Etype (A))
+ and then not Is_By_Reference_Type (Etype (A))
and then
(not Is_Array_Type (Etype (A))
or else not Is_Object_Reference (A)
