aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteve Baird <baird@adacore.com>2021-05-18 18:26:24 -0700
committerPierre-Marie de Rodat <derodat@adacore.com>2021-07-07 16:23:15 +0000
commit2d71668e64c4b20aec823dbe5a1feb6338d527a2 (patch)
treea726436c73f7053302fcf2a77ee5106a51447d6a
parent4fa7097a140f007f86e81f62cd08fff15b16ef6e (diff)
downloadgcc-2d71668e64c4b20aec823dbe5a1feb6338d527a2.zip
gcc-2d71668e64c4b20aec823dbe5a1feb6338d527a2.tar.gz
gcc-2d71668e64c4b20aec823dbe5a1feb6338d527a2.tar.bz2
[Ada] Improve interactions between DSA and Put_Image routines for tagged types
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.
-rw-r--r--gcc/ada/exp_dist.adb26
1 files changed, 3 insertions, 23 deletions
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index 35ccf9d..5cb8fb5 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -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,