https://gcc.gnu.org/g:753e088fdd786a25a20b94b5e3b6d5708191468d
commit r16-5381-g753e088fdd786a25a20b94b5e3b6d5708191468d Author: Steve Baird <[email protected]> Date: Tue Nov 4 15:01:14 2025 -0800 ada: Avoid duplicate streaming and Put_Image subprograms (part2). 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. Diff: --- 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 3282417c2a41..f9436f78a41c 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
