]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
[Ada] Improve interactions between DSA and Put_Image routines for tagged types
authorSteve Baird <baird@adacore.com>
Wed, 19 May 2021 01:26:24 +0000 (18:26 -0700)
committerPierre-Marie de Rodat <derodat@adacore.com>
Wed, 7 Jul 2021 16:23:15 +0000 (16:23 +0000)
gcc/ada/

* exp_dist.adb (Add_RACW_Primitive_Declarations_And_Bodies): Add
TSS_Put_Image to list of predefined primitives that need special
treatment.
(Build_General_Calling_Stubs, Build_Subprogram_Receiving_Stubs):
Remove previous hack for dealing with TSS_Put_Image procedures.

gcc/ada/exp_dist.adb

index 35ccf9d3731a8d485fd36ed43129a0f987573073..5cb8fb54993eb17d01462a54675130f81040c25c 100644 (file)
@@ -1424,6 +1424,7 @@ package body Exp_Dist is
               and then Chars (Current_Primitive) /= Name_uAlignment
               and then not
                 (Is_TSS (Current_Primitive, TSS_Deep_Finalize) or else
+                 Is_TSS (Current_Primitive, TSS_Put_Image)     or else
                  Is_TSS (Current_Primitive, TSS_Stream_Input)  or else
                  Is_TSS (Current_Primitive, TSS_Stream_Output) or else
                  Is_TSS (Current_Primitive, TSS_Stream_Read)   or else
@@ -4211,14 +4212,6 @@ package body Exp_Dist is
          --  Used only for the PolyORB case
 
       begin
-         --  workaround for later failures in Exp_Util.Find_Prim_Op
-         if Is_TSS (Defining_Unit_Name (Spec), TSS_Put_Image) then
-            Append_To (Statements,
-                       Make_Raise_Program_Error (Loc,
-                         Reason => PE_Stream_Operation_Not_Allowed));
-            return;
-         end if;
-
          --  The general form of a calling stub for a given subprogram is:
 
          --    procedure X (...) is P : constant Partition_ID :=
@@ -4734,11 +4727,11 @@ package body Exp_Dist is
          --  Formal parameter for receiving stubs: a descriptor for an incoming
          --  request.
 
-         Decls : List_Id := New_List;
+         Decls : constant List_Id := New_List;
          --  All the parameters will get declared before calling the real
          --  subprograms. Also the out parameters will be declared.
 
-         Statements : List_Id := New_List;
+         Statements : constant List_Id := New_List;
 
          Extra_Formal_Statements : constant List_Id := New_List;
          --  Statements concerning extra formal parameters
@@ -5173,19 +5166,6 @@ package body Exp_Dist is
                  Parameter_Type      =>
                    New_Occurrence_Of (RTE (RE_Request_Access), Loc))));
 
-         --  workaround for later failures in Exp_Util.Find_Prim_Op
-         if Is_TSS (Defining_Unit_Name (Specification (Vis_Decl)),
-                    TSS_Put_Image)
-         then
-            --  drop everything on the floor
-            Decls := New_List;
-            Statements := New_List;
-            Excep_Handlers := New_List;
-            Append_To (Statements,
-                       Make_Raise_Program_Error (Loc,
-                         Reason => PE_Stream_Operation_Not_Allowed));
-         end if;
-
          return
            Make_Subprogram_Body (Loc,
              Specification              => Subp_Spec,