From: Steve Baird <[email protected]>
Follow up fixes for earlier changes made for this issue.
gcc/ada/ChangeLog:
* exp_attr.adb (Expand_N_Attribute_Reference): Ensure that
Build_Record_Or_Elementary_Input_Function and
Build_Record_Or_Elementary_Output_Procedure are only called
from within an instance of Build_And_Insert_Type_Attr_Subp.
In particular, the results returned by those 2 functions should
not be passed directly to Insert_Action. This is needed to
ensure that the newly-built subprogram is inserted at the correct
point in the tree.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_attr.adb | 58 +++++++++++++++++++++++---------------------
1 file changed, 30 insertions(+), 28 deletions(-)
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 3282417c2a4..f9436f78a41 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2186,6 +2186,16 @@ package body Exp_Attr is
end if;
end Build_And_Insert_Type_Attr_Subp;
+ -- Two instances, used for doing what the instance names suggest.
+
+ procedure Build_And_Insert_Record_Or_Elementary_Input_Func is
+ new Build_And_Insert_Type_Attr_Subp
+ (Build_Record_Or_Elementary_Input_Function);
+
+ procedure Build_And_Insert_Record_Or_Elementary_Output_Proc is
+ new Build_And_Insert_Type_Attr_Subp
+ (Build_Record_Or_Elementary_Output_Procedure);
+
----------------------
-- Get_Integer_Type --
----------------------
@@ -4761,9 +4771,11 @@ package body Exp_Attr is
-- since in this case we are required to call this routine.
if Present (Find_Inherited_TSS (P_Type, TSS_Stream_Read)) then
- Build_Record_Or_Elementary_Input_Function
- (P_Type, Decl, Fname);
- Insert_Action (N, Decl);
+ Build_And_Insert_Record_Or_Elementary_Input_Func
+ (Typ => Base_Type (U_Type),
+ Decl => Decl,
+ Subp => Fname,
+ Attr_Ref => N);
-- For normal cases, we call the I_xxx routine directly
@@ -4882,17 +4894,11 @@ package body Exp_Attr is
-- first named subtype is unconstrained? Shouldn't we be
-- passing in the first named subtype of the type?
- declare
- procedure Build_And_Insert_Record_Input_Func is
- new Build_And_Insert_Type_Attr_Subp
- (Build_Record_Or_Elementary_Input_Function);
- begin
- Build_And_Insert_Record_Input_Func
- (Typ => U_Type,
- Decl => Decl,
- Subp => Fname,
- Attr_Ref => N);
- end;
+ Build_And_Insert_Record_Or_Elementary_Input_Func
+ (Typ => Underlying_Type (First_Subtype (P_Type)),
+ Decl => Decl,
+ Subp => Fname,
+ Attr_Ref => N);
if Nkind (Parent (N)) = N_Object_Declaration
and then Is_Record_Type (U_Type)
@@ -5952,9 +5958,11 @@ package body Exp_Attr is
-- since in this case we are required to call this routine.
if Present (Find_Inherited_TSS (P_Type, TSS_Stream_Write)) then
- Build_Record_Or_Elementary_Output_Procedure
- (P_Type, Decl, Pname);
- Insert_Action (N, Decl);
+ Build_And_Insert_Record_Or_Elementary_Output_Proc
+ (Typ => Base_Type (U_Type),
+ Decl => Decl,
+ Subp => Pname,
+ Attr_Ref => N);
-- For normal cases, we call the W_xxx routine directly
@@ -6033,17 +6041,11 @@ package body Exp_Attr is
return;
end if;
- declare
- procedure Build_And_Insert_Record_Output_Proc is
- new Build_And_Insert_Type_Attr_Subp
- (Build_Record_Or_Elementary_Output_Procedure);
- begin
- Build_And_Insert_Record_Output_Proc
- (Typ => Base_Type (U_Type),
- Decl => Decl,
- Subp => Pname,
- Attr_Ref => N);
- end;
+ Build_And_Insert_Record_Or_Elementary_Output_Proc
+ (Typ => Underlying_Type (First_Subtype (P_Type)),
+ Decl => Decl,
+ Subp => Pname,
+ Attr_Ref => N);
end if;
if not Is_Tagged_Type (U_Type) then
--
2.51.0
