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 --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 3282417c2a41977bb701b3138db01015cb97fbd9..f9436f78a41ce49933cac3d8879d09c093f68f1a 100644 (file)
--- 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