Skip to content

R
riscv-gcc-1
Commit 25e9b6fe by Thomas Quinot Committed by Arnaud Charlet
Options

2008-05-20 Thomas Quinot <quinot@adacore.com> 

	* exp_dist.adb
	(GARLIC_Support.Add_RACW_Read_Attribute): When a zero value is received,
	and the RACW is null-excluding, raise CONSTRAINT_ERROR instead of
	assigning NULL into the result, to avoid a spurious warning.
	(Add_RACW_Features, case Same_Scope): Add assertion that designated type
	is not frozen.
	(Add_Stub_Type): Set entity flag Is_RACW_Stub_Type on generated stub
	type.
	(Build_From_Any_Function, Build_To_Any_Function,
	Build_TypeCode_Function): For a type that has user-specified stream
	attributes, use an opaque sequence of octets as the representation.

From-SVN: r135626
parent 5b7dd52d
Showing with 201 additions and 94 deletions
gcc/ada/exp_dist.adb
...@@ -1085,8 +1085,8 @@ package body Exp_Dist is ...@@ -1085,8 +1085,8 @@ package body Exp_Dist is
Existing : Boolean; Existing : Boolean;
-- True when appropriate stubs have already been generated (this is the -- True when appropriate stubs have already been generated (this is the
-- case when another RACW with the same designated type has already been -- case when another RACW with the same designated type has already been
-- encountered, in which case we reuse the previous stubs rather than -- encountered), in which case we reuse the previous stubs rather than
-- generating new ones). -- generating new ones.
begin begin
if not Expander_Active then if not Expander_Active then
...@@ -1164,12 +1164,13 @@ package body Exp_Dist is ...@@ -1164,12 +1164,13 @@ package body Exp_Dist is
RPC_Receiver_Decl => RPC_Receiver_Decl, RPC_Receiver_Decl => RPC_Receiver_Decl,
Body_Decls => Body_Decls); Body_Decls => Body_Decls);
if not Same_Scope and then not Existing then -- If we already have stubs for this designated type, nothing to do
-- The RACW has been declared in another scope than the designated if Existing then
-- type and has not been handled by another RACW in the same package return;
-- as the first one, so add primitives for the stub type here. end if;
if Is_Frozen (Desig) then
Validate_RACW_Primitives (RACW_Type); Validate_RACW_Primitives (RACW_Type);
Add_RACW_Primitive_Declarations_And_Bodies Add_RACW_Primitive_Declarations_And_Bodies
(Designated_Type => Desig, (Designated_Type => Desig,
...@@ -1177,10 +1178,9 @@ package body Exp_Dist is ...@@ -1177,10 +1178,9 @@ package body Exp_Dist is
Body_Decls => Body_Decls); Body_Decls => Body_Decls);
else else
-- Validate_RACW_Primitives will be called when the designated type -- Validate_RACW_Primitives requires the list of all primitives of
-- is frozen, see Exp_Ch3.Freeze_Type. -- the designated type, so defer processing until Desig is frozen.
-- See Exp_Ch3.Freeze_Type.
-- ??? Shouldn't we have a pragma Assert (not Is_Frozen (Desig))?
Add_Access_Type_To_Process (E => Desig, A => RACW_Type); Add_Access_Type_To_Process (E => Desig, A => RACW_Type);
end if; end if;
...@@ -1870,6 +1870,8 @@ package body Exp_Dist is ...@@ -1870,6 +1870,8 @@ package body Exp_Dist is
Stub_Type := Stub_Type :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('S')); Chars => New_Internal_Name ('S'));
Set_Ekind (Stub_Type, E_Record_Type);
Set_Is_RACW_Stub_Type (Stub_Type);
Stub_Type_Access := Stub_Type_Access :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => New_External_Name Chars => New_External_Name
...@@ -3085,19 +3087,34 @@ package body Exp_Dist is ...@@ -3085,19 +3087,34 @@ package body Exp_Dist is
Set_Etype (Stubbed_Result, Stub_Type_Access); Set_Etype (Stubbed_Result, Stub_Type_Access);
-- If the Address is Null_Address, then return a null object -- If the Address is Null_Address, then return a null object, unless
-- RACW_Type is null-excluding, in which case inconditionally raise
-- CONSTRAINT_ERROR instead.
Append_To (Statements, declare
Make_Implicit_If_Statement (RACW_Type, Zero_Statements : List_Id;
Condition => -- Statements executed when a zero value is received
Make_Op_Eq (Loc, begin
Left_Opnd => New_Occurrence_Of (Source_Address, Loc), if Can_Never_Be_Null (RACW_Type) then
Right_Opnd => Make_Integer_Literal (Loc, Uint_0)), Zero_Statements := New_List (
Then_Statements => New_List ( Make_Raise_Constraint_Error (Loc,
Make_Assignment_Statement (Loc, Reason => CE_Null_Not_Allowed));
Name => Result, else
Expression => Make_Null (Loc)), Zero_Statements := New_List (
Make_Simple_Return_Statement (Loc)))); Make_Assignment_Statement (Loc,
Name => Result,
Expression => Make_Null (Loc)),
Make_Simple_Return_Statement (Loc));
end if;
Append_To (Statements,
Make_Implicit_If_Statement (RACW_Type,
Condition =>
Make_Op_Eq (Loc,
Left_Opnd => New_Occurrence_Of (Source_Address, Loc),
Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
Then_Statements => Zero_Statements));
end;
-- If the RACW denotes an object created on the current partition, -- If the RACW denotes an object created on the current partition,
-- Local_Statements will be executed. The real object will be used. -- Local_Statements will be executed. The real object will be used.
...@@ -8470,7 +8487,7 @@ package body Exp_Dist is ...@@ -8470,7 +8487,7 @@ package body Exp_Dist is
function Find_Numeric_Representation function Find_Numeric_Representation
(Typ : Entity_Id) return Entity_Id; (Typ : Entity_Id) return Entity_Id;
-- Given a numeric type Typ, return the smallest integer or floarting -- Given a numeric type Typ, return the smallest integer or floating
-- point type from Standard, or the smallest unsigned (modular) type -- point type from Standard, or the smallest unsigned (modular) type
-- from System.Unsigned_Types, whose range encompasses that of Typ. -- from System.Unsigned_Types, whose range encompasses that of Typ.
...@@ -8729,11 +8746,16 @@ package body Exp_Dist is ...@@ -8729,11 +8746,16 @@ package body Exp_Dist is
Decl : out Node_Id; Decl : out Node_Id;
Fnam : out Entity_Id) Fnam : out Entity_Id)
is is
Spec : Node_Id; Spec : Node_Id;
Decls : constant List_Id := New_List; Decls : constant List_Id := New_List;
Stms : constant List_Id := New_List; Stms : constant List_Id := New_List;
Any_Parameter : constant Entity_Id
:= Make_Defining_Identifier (Loc, New_Internal_Name ('A')); Any_Parameter : constant Entity_Id :=
Make_Defining_Identifier (Loc,
New_Internal_Name ('A'));
Use_Opaque_Representation : Boolean;
begin begin
if Is_Itype (Typ) then if Is_Itype (Typ) then
Build_From_Any_Function Build_From_Any_Function
...@@ -8763,9 +8785,21 @@ package body Exp_Dist is ...@@ -8763,9 +8785,21 @@ package body Exp_Dist is
pragma Assert pragma Assert
(not (Is_Remote_Access_To_Class_Wide_Type (Typ))); (not (Is_Remote_Access_To_Class_Wide_Type (Typ)));
if Is_Derived_Type (Typ) Use_Opaque_Representation := False;
and then not Is_Tagged_Type (Typ)
if Has_Stream_Attribute_Definition
(Typ, TSS_Stream_Output, At_Any_Place => True)
or else
Has_Stream_Attribute_Definition
(Typ, TSS_Stream_Write, At_Any_Place => True)
then then
-- If user-defined stream attributes are specified for this
-- type, use them and transmit data as an opaque sequence of
-- stream elements.
Use_Opaque_Representation := True;
elsif Is_Derived_Type (Typ) and then not Is_Tagged_Type (Typ) then
Append_To (Stms, Append_To (Stms,
Make_Simple_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
...@@ -9292,6 +9326,11 @@ package body Exp_Dist is ...@@ -9292,6 +9326,11 @@ package body Exp_Dist is
Decls)))); Decls))));
else else
Use_Opaque_Representation := True;
end if;
if Use_Opaque_Representation then
-- Default: type is represented as an opaque sequence of bytes -- Default: type is represented as an opaque sequence of bytes
declare declare
...@@ -9588,6 +9627,10 @@ package body Exp_Dist is ...@@ -9588,6 +9627,10 @@ package body Exp_Dist is
Any_Decl : Node_Id; Any_Decl : Node_Id;
Result_TC : Node_Id := Build_TypeCode_Call (Loc, Typ, Decls); Result_TC : Node_Id := Build_TypeCode_Call (Loc, Typ, Decls);
Use_Opaque_Representation : Boolean;
-- When True, use stream attributes and represent type as an
-- opaque sequence of bytes.
begin begin
if Is_Itype (Typ) then if Is_Itype (Typ) then
Build_To_Any_Function Build_To_Any_Function
...@@ -9598,8 +9641,8 @@ package body Exp_Dist is ...@@ -9598,8 +9641,8 @@ package body Exp_Dist is
return; return;
end if; end if;
Fnam := Make_Stream_Procedure_Function_Name (Loc, Fnam :=
Typ, Name_uTo_Any); Make_Stream_Procedure_Function_Name (Loc, Typ, Name_uTo_Any);
Spec := Spec :=
Make_Function_Specification (Loc, Make_Function_Specification (Loc,
...@@ -9620,39 +9663,58 @@ package body Exp_Dist is ...@@ -9620,39 +9663,58 @@ package body Exp_Dist is
Object_Definition => Object_Definition =>
New_Occurrence_Of (RTE (RE_Any), Loc)); New_Occurrence_Of (RTE (RE_Any), Loc));
if Is_Derived_Type (Typ) and then not Is_Tagged_Type (Typ) then Use_Opaque_Representation := False;
if Has_Stream_Attribute_Definition
(Typ, TSS_Stream_Output, At_Any_Place => True)
or else
Has_Stream_Attribute_Definition
(Typ, TSS_Stream_Write, At_Any_Place => True)
then
-- If user-defined stream attributes are specified for this
-- type, use them and transmit data as an opaque sequence of
-- stream elements.
Use_Opaque_Representation := True;
elsif Is_Derived_Type (Typ) and then not Is_Tagged_Type (Typ) then
-- Non-tagged derived type: convert to root type
declare declare
Rt_Type : constant Entity_Id Rt_Type : constant Entity_Id := Root_Type (Typ);
:= Root_Type (Typ); Expr : constant Node_Id :=
Expr : constant Node_Id OK_Convert_To
:= OK_Convert_To ( (Rt_Type,
Rt_Type, New_Occurrence_Of (Expr_Parameter, Loc));
New_Occurrence_Of (Expr_Parameter, Loc));
begin begin
Set_Expression (Any_Decl, Build_To_Any_Call (Expr, Decls)); Set_Expression (Any_Decl, Build_To_Any_Call (Expr, Decls));
end; end;
elsif Is_Record_Type (Typ) and then not Is_Tagged_Type (Typ) then elsif Is_Record_Type (Typ) and then not Is_Tagged_Type (Typ) then
-- Non-tagged record type
if Nkind (Declaration_Node (Typ)) = N_Subtype_Declaration then if Nkind (Declaration_Node (Typ)) = N_Subtype_Declaration then
declare declare
Rt_Type : constant Entity_Id Rt_Type : constant Entity_Id := Etype (Typ);
:= Etype (Typ); Expr : constant Node_Id :=
Expr : constant Node_Id OK_Convert_To (Rt_Type,
:= OK_Convert_To ( New_Occurrence_Of (Expr_Parameter, Loc));
Rt_Type,
New_Occurrence_Of (Expr_Parameter, Loc));
begin begin
Set_Expression (Any_Decl, Set_Expression (Any_Decl,
Build_To_Any_Call (Expr, Decls)); Build_To_Any_Call (Expr, Decls));
end; end;
-- Comment needed here (and label on declare block ???)
else else
declare declare
Disc : Entity_Id := Empty; Disc : Entity_Id := Empty;
Rdef : constant Node_Id := Rdef : constant Node_Id :=
Type_Definition (Declaration_Node (Typ)); Type_Definition (Declaration_Node (Typ));
Counter : Int := 0; Counter : Int := 0;
Elements : constant List_Id := New_List; Elements : constant List_Id := New_List;
procedure TA_Rec_Add_Process_Element procedure TA_Rec_Add_Process_Element
...@@ -9661,6 +9723,7 @@ package body Exp_Dist is ...@@ -9661,6 +9723,7 @@ package body Exp_Dist is
Counter : in out Int; Counter : in out Int;
Rec : Entity_Id; Rec : Entity_Id;
Field : Node_Id); Field : Node_Id);
-- Processing routine for traversal below
procedure TA_Append_Record_Traversal is procedure TA_Append_Record_Traversal is
new Append_Record_Traversal new Append_Record_Traversal
...@@ -9702,15 +9765,15 @@ package body Exp_Dist is ...@@ -9702,15 +9765,15 @@ package body Exp_Dist is
else else
-- A variant part -- A variant part
declare Variant_Part : declare
Variant : Node_Id; Variant : Node_Id;
Struct_Counter : Int := 0; Struct_Counter : Int := 0;
Block_Decls : constant List_Id := New_List; Block_Decls : constant List_Id := New_List;
Block_Stmts : constant List_Id := New_List; Block_Stmts : constant List_Id := New_List;
VP_Stmts : List_Id; VP_Stmts : List_Id;
Alt_List : constant List_Id := New_List; Alt_List : constant List_Id := New_List;
Choice_List : List_Id; Choice_List : List_Id;
Union_Any : constant Entity_Id := Union_Any : constant Entity_Id :=
...@@ -9723,8 +9786,8 @@ package body Exp_Dist is ...@@ -9723,8 +9786,8 @@ package body Exp_Dist is
function Make_Discriminant_Reference function Make_Discriminant_Reference
return Node_Id; return Node_Id;
-- Build a selected component for the -- Build reference to the discriminant for this
-- discriminant of this variant part. -- variant part.
--------------------------------- ---------------------------------
-- Make_Discriminant_Reference -- -- Make_Discriminant_Reference --
...@@ -9743,6 +9806,8 @@ package body Exp_Dist is ...@@ -9743,6 +9806,8 @@ package body Exp_Dist is
return Nod; return Nod;
end Make_Discriminant_Reference; end Make_Discriminant_Reference;
-- Start processing for Variant_Part
begin begin
Append_To (Stmts, Append_To (Stmts,
Make_Block_Statement (Loc, Make_Block_Statement (Loc,
...@@ -9752,11 +9817,10 @@ package body Exp_Dist is ...@@ -9752,11 +9817,10 @@ package body Exp_Dist is
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
Statements => Block_Stmts))); Statements => Block_Stmts)));
-- Declare the Variant Part aggregate -- Declare variant part aggregate (Union_Any).
-- (Union_Any). -- Knowing the position of this VP in the
-- Knowing the position of this VP in -- variant record, we can fetch the VP typecode
-- the variant record, we can fetch the -- from Container.
-- VP typecode from Container.
Append_To (Block_Decls, Append_To (Block_Decls,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
...@@ -9777,9 +9841,8 @@ package body Exp_Dist is ...@@ -9777,9 +9841,8 @@ package body Exp_Dist is
Make_Integer_Literal (Loc, Make_Integer_Literal (Loc,
Counter))))))); Counter)))))));
-- Declare the inner struct aggregate -- Declare inner struct aggregate (which
-- (that will contain the components -- contains the components of this VP).
-- of this VP)
Append_To (Block_Decls, Append_To (Block_Decls,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
...@@ -9800,9 +9863,7 @@ package body Exp_Dist is ...@@ -9800,9 +9863,7 @@ package body Exp_Dist is
Make_Integer_Literal (Loc, Make_Integer_Literal (Loc,
Uint_1))))))); Uint_1)))))));
-- Construct a case statement that will choose -- Build case statement
-- the appropriate code at runtime depending on
-- the discriminant.
Append_To (Block_Stmts, Append_To (Block_Stmts,
Make_Case_Statement (Loc, Make_Case_Statement (Loc,
...@@ -9818,8 +9879,7 @@ package body Exp_Dist is ...@@ -9818,8 +9879,7 @@ package body Exp_Dist is
VP_Stmts := New_List; VP_Stmts := New_List;
-- Append discriminant value to union -- Append discriminant val to union aggregate
-- aggregate.
Append_To (VP_Stmts, Append_To (VP_Stmts,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
...@@ -9878,8 +9938,9 @@ package body Exp_Dist is ...@@ -9878,8 +9938,9 @@ package body Exp_Dist is
Next_Non_Pragma (Variant); Next_Non_Pragma (Variant);
end loop; end loop;
end; end Variant_Part;
end if; end if;
Counter := Counter + 1; Counter := Counter + 1;
end TA_Rec_Add_Process_Element; end TA_Rec_Add_Process_Element;
...@@ -9989,6 +10050,9 @@ package body Exp_Dist is ...@@ -9989,6 +10050,9 @@ package body Exp_Dist is
end if; end if;
elsif Is_Array_Type (Typ) then elsif Is_Array_Type (Typ) then
-- Constrained and unconstrained array types
declare declare
Constrained : constant Boolean := Is_Constrained (Typ); Constrained : constant Boolean := Is_Constrained (Typ);
...@@ -10074,6 +10138,9 @@ package body Exp_Dist is ...@@ -10074,6 +10138,9 @@ package body Exp_Dist is
end; end;
elsif Is_Integer_Type (Typ) or else Is_Unsigned_Type (Typ) then elsif Is_Integer_Type (Typ) or else Is_Unsigned_Type (Typ) then
-- Integer types
Set_Expression (Any_Decl, Set_Expression (Any_Decl,
Build_To_Any_Call ( Build_To_Any_Call (
OK_Convert_To ( OK_Convert_To (
...@@ -10082,14 +10149,22 @@ package body Exp_Dist is ...@@ -10082,14 +10149,22 @@ package body Exp_Dist is
Decls)); Decls));
else else
-- Default: type is represented as an opaque sequence of bytes -- Default case, including tagged types: opaque representation
Use_Opaque_Representation := True;
end if;
if Use_Opaque_Representation then
declare declare
Strm : constant Entity_Id := Make_Defining_Identifier (Loc, Strm : constant Entity_Id :=
New_Internal_Name ('S')); Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('S'));
-- Stream used to store data representation produced by
-- stream attribute.
begin begin
-- Strm : aliased Buffer_Stream_Type; -- Generate:
-- Strm : aliased Buffer_Stream_Type;
Append_To (Decls, Append_To (Decls,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
...@@ -10100,7 +10175,8 @@ package body Exp_Dist is ...@@ -10100,7 +10175,8 @@ package body Exp_Dist is
Object_Definition => Object_Definition =>
New_Occurrence_Of (RTE (RE_Buffer_Stream_Type), Loc))); New_Occurrence_Of (RTE (RE_Buffer_Stream_Type), Loc)));
-- Allocate_Buffer (Strm); -- Generate:
-- Allocate_Buffer (Strm);
Append_To (Stms, Append_To (Stms,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
...@@ -10109,19 +10185,21 @@ package body Exp_Dist is ...@@ -10109,19 +10185,21 @@ package body Exp_Dist is
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Occurrence_Of (Strm, Loc)))); New_Occurrence_Of (Strm, Loc))));
-- T'Output (Strm'Access, E); -- Generate:
-- T'Output (Strm'Access, E);
Append_To (Stms, Append_To (Stms,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Typ, Loc), Prefix => New_Occurrence_Of (Typ, Loc),
Attribute_Name => Name_Output, Attribute_Name => Name_Output,
Expressions => New_List ( Expressions => New_List (
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Strm, Loc), Prefix => New_Occurrence_Of (Strm, Loc),
Attribute_Name => Name_Access), Attribute_Name => Name_Access),
New_Occurrence_Of (Expr_Parameter, Loc)))); New_Occurrence_Of (Expr_Parameter, Loc))));
-- BS_To_Any (Strm, A); -- Generate:
-- BS_To_Any (Strm, A);
Append_To (Stms, Append_To (Stms,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
...@@ -10131,7 +10209,8 @@ package body Exp_Dist is ...@@ -10131,7 +10209,8 @@ package body Exp_Dist is
New_Occurrence_Of (Strm, Loc), New_Occurrence_Of (Strm, Loc),
New_Occurrence_Of (Any, Loc)))); New_Occurrence_Of (Any, Loc))));
-- Release_Buffer (Strm); -- Generate:
-- Release_Buffer (Strm);
Append_To (Stms, Append_To (Stms,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
...@@ -10175,14 +10254,13 @@ package body Exp_Dist is ...@@ -10175,14 +10254,13 @@ package body Exp_Dist is
Typ : Entity_Id; Typ : Entity_Id;
Decls : List_Id) return Node_Id Decls : List_Id) return Node_Id
is is
U_Type : Entity_Id := Underlying_Type (Typ); U_Type : Entity_Id := Underlying_Type (Typ);
-- The full view, if Typ is private; the completion, -- The full view, if Typ is private; the completion,
-- if Typ is incomplete. -- if Typ is incomplete.
Fnam : Entity_Id := Empty; Fnam : Entity_Id := Empty;
Lib_RE : RE_Id := RE_Null; Lib_RE : RE_Id := RE_Null;
Expr : Node_Id;
Expr : Node_Id;
begin begin
-- Special case System.PolyORB.Interface.Any: its primitives have -- Special case System.PolyORB.Interface.Any: its primitives have
...@@ -10729,22 +10807,29 @@ package body Exp_Dist is ...@@ -10729,22 +10807,29 @@ package body Exp_Dist is
Initialize_Parameter_List Initialize_Parameter_List
(Type_Name_Str, Type_Repo_Id_Str, Parameters); (Type_Name_Str, Type_Repo_Id_Str, Parameters);
if Is_Derived_Type (Typ) if Has_Stream_Attribute_Definition
and then not Is_Tagged_Type (Typ) (Typ, TSS_Stream_Output, At_Any_Place => True)
or else
Has_Stream_Attribute_Definition
(Typ, TSS_Stream_Write, At_Any_Place => True)
then then
-- If user-defined stream attributes are specified for this
-- type, use them and transmit data as an opaque sequence of
-- stream elements.
Return_Alias_TypeCode
(New_Occurrence_Of (RTE (RE_TC_Opaque), Loc));
elsif Is_Derived_Type (Typ) and then not Is_Tagged_Type (Typ) then
Return_Alias_TypeCode ( Return_Alias_TypeCode (
Build_TypeCode_Call (Loc, Etype (Typ), Decls)); Build_TypeCode_Call (Loc, Etype (Typ), Decls));
elsif Is_Integer_Type (Typ) elsif Is_Integer_Type (Typ) or else Is_Unsigned_Type (Typ) then
or else Is_Unsigned_Type (Typ)
then
Return_Alias_TypeCode ( Return_Alias_TypeCode (
Build_TypeCode_Call (Loc, Build_TypeCode_Call (Loc,
Find_Numeric_Representation (Typ), Decls)); Find_Numeric_Representation (Typ), Decls));
elsif Is_Record_Type (Typ) elsif Is_Record_Type (Typ) and then not Is_Tagged_Type (Typ) then
and then not Is_Tagged_Type (Typ)
then
-- Record typecodes are encoded as follows: -- Record typecodes are encoded as follows:
-- -- TC_STRUCT -- -- TC_STRUCT
...@@ -11280,11 +11365,33 @@ package body Exp_Dist is ...@@ -11280,11 +11365,33 @@ package body Exp_Dist is
Stub_Elements : constant Stub_Structure := Stub_Elements : constant Stub_Structure :=
Stubs_Table.Get (Full_View); Stubs_Table.Get (Full_View);
begin begin
-- For an RACW encountered before the freeze point of its designated
-- type, the stub type is generated at the point of the RACW declaration
-- but the primitives are generated only once the designated type is
-- frozen. That freeze can occur in another scope, for example when the
-- RACW is declared in a nested package. In that case we need to
-- reestablish the stub type's scope prior to generating its primitive
-- operations.
if Stub_Elements /= Empty_Stub_Structure then if Stub_Elements /= Empty_Stub_Structure then
Add_RACW_Primitive_Declarations_And_Bodies declare
(Full_View, Saved_Scope : constant Entity_Id := Current_Scope;
Stub_Elements.RPC_Receiver_Decl, Stubs_Scope : constant Entity_Id :=
Stub_Elements.Body_Decls); Scope (Stub_Elements.Stub_Type);
begin
if Current_Scope /= Stubs_Scope then
Push_Scope (Stubs_Scope);
end if;
Add_RACW_Primitive_Declarations_And_Bodies
(Full_View,
Stub_Elements.RPC_Receiver_Decl,
Stub_Elements.Body_Decls);
if Current_Scope /= Saved_Scope then
Pop_Scope;
end if;
end;
end if; end if;
end Remote_Types_Tagged_Full_View_Encountered; end Remote_Types_Tagged_Full_View_Encountered;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment