+2009-07-10 Thomas Quinot <quinot@adacore.com>
+
+ * exp_disp.adb (Make_Disp_Asynchronous_Select_Body,
+ Make_Disp_Conditional_Select_Body,
+ Make_Disp_Timed_Select_Body): For the case of a type that is neither an
+ interface nor a concurrent type, the primitive body is empty. Generate
+ a null statement so that it remains well formed.
+
+2009-07-10 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_aggr.adb (Build_Record_Aggr_Code): If the type has discriminants,
+ replace references to them in defaulted component expressions with
+ references to the values of the discriminants of the target object.
+
2009-07-10 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Analyze pragma, case Task_Name): Analyze argument of
end if;
end Gen_Ctrl_Actions_For_Aggr;
+ function Rewrite_Discriminant (Expr : Node_Id) return Traverse_Result;
+ -- If the default expression of a component mentions a discriminant of
+ -- the type, it has to be rewritten as the discriminant of the target
+ -- object.
+
function Replace_Type (Expr : Node_Id) return Traverse_Result;
-- If the aggregate contains a self-reference, traverse each expression
-- to replace a possible self-reference with a reference to the proper
-- component of the target of the assignment.
+ --------------------------
+ -- Rewrite_Discriminant --
+ --------------------------
+
+ function Rewrite_Discriminant (Expr : Node_Id) return Traverse_Result is
+ begin
+ if Nkind (Expr) = N_Identifier
+ and then Present (Entity (Expr))
+ and then Ekind (Entity (Expr)) = E_In_Parameter
+ and then Present (Discriminal_Link (Entity (Expr)))
+ then
+ Rewrite (Expr,
+ Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Obj, Loc),
+ Selector_Name => Make_Identifier (Loc, Chars (Expr))));
+ end if;
+ return OK;
+ end Rewrite_Discriminant;
+
------------------
-- Replace_Type --
------------------
procedure Replace_Self_Reference is
new Traverse_Proc (Replace_Type);
+ procedure Replace_Discriminants is
+ new Traverse_Proc (Rewrite_Discriminant);
+
-- Start of processing for Build_Record_Aggr_Code
begin
-- Expr_Q is not delayed aggregate
else
+ if Has_Discriminants (Typ) then
+ Replace_Discriminants (Expr_Q);
+ end if;
+
Instr :=
Make_OK_Assignment_Statement (Loc,
Name => Comp_Expr,
- Expression => Expression (Comp));
+ Expression => Expr_Q);
Set_No_Ctrl_Actions (Instr);
Append_To (L, Instr);
RTE (RE_Asynchronous_Call), Loc),
Make_Identifier (Loc, Name_uF)))); -- status flag
end if;
+
+ else
+ -- Ensure that the statements list is non-empty
+
+ Append_To (Stmts, Make_Null_Statement (Loc));
end if;
return
RTE (RE_Conditional_Call), Loc),
Make_Identifier (Loc, Name_uF)))); -- status flag
end if;
+
+ else
+ -- Ensure that the statements list is non-empty
+
+ Append_To (Stmts, Make_Null_Statement (Loc));
end if;
return
Make_Identifier (Loc, Name_uM), -- delay mode
Make_Identifier (Loc, Name_uF)))); -- status flag
end if;
+
+ else
+ -- Ensure that the statements list is non-empty
+
+ Append_To (Stmts, Make_Null_Statement (Loc));
end if;
return