+2011-08-01 Robert Dewar <dewar@adacore.com>
+
+ * i-cstrin.adb, sem_util.adb, exp_ch11.adb, sem_ch8.adb,
+ lib-xref.adb: Minor reformatting
+
+2011-08-01 Gary Dismukes <dismukes@adacore.com>
+
+ * exp_ch6.adb (Expand_N_Extended_Return_Statement): Replace test of
+ when to generate a call to Move_Final_List.
+ (Has_Controlled_Parts): Remove this function.
+
2011-08-01 Geert Bosch <bosch@adacore.com>
* par-ch3.adb (P_Discrete_Choice_List): Improve error message for extra
if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then
Src := Comes_From_Source (N);
+
if Entity (Name (N)) = Standard_Constraint_Error then
Rewrite (N,
Make_Raise_Constraint_Error (Loc, Reason => CE_Explicit_Raise));
Parent (Return_Object_Entity);
Parent_Function : constant Entity_Id :=
Return_Applies_To (Return_Statement_Entity (N));
- Parent_Function_Typ : constant Entity_Id := Etype (Parent_Function);
Is_Build_In_Place : constant Boolean :=
Is_Build_In_Place_Function (Parent_Function);
Result : Node_Id;
Exp : Node_Id;
- function Has_Controlled_Parts (Typ : Entity_Id) return Boolean;
- -- Determine whether type Typ is controlled or contains a controlled
- -- subcomponent.
-
function Move_Activation_Chain return Node_Id;
-- Construct a call to System.Tasking.Stages.Move_Activation_Chain
-- with parameters:
-- From finalization list of the return statement
-- To finalization list passed in by the caller
- --------------------------
- -- Has_Controlled_Parts --
- --------------------------
-
- function Has_Controlled_Parts (Typ : Entity_Id) return Boolean is
- begin
- return
- Is_Controlled (Typ)
- or else Has_Controlled_Component (Typ);
- end Has_Controlled_Parts;
-
---------------------------
-- Move_Activation_Chain --
---------------------------
-- finalization list. A special case arises when processing a simple
-- return statement which has been rewritten as an extended return.
-- In that case check the type of the returned object or the original
- -- expression.
+ -- expression. Note that Needs_Finalization accounts for the case
+ -- of class-wide types, which which must be assumed to require
+ -- finalization.
if Is_Build_In_Place
+ and then Needs_BIP_Final_List (Parent_Function)
and then
- (Has_Controlled_Parts (Parent_Function_Typ)
- or else (Is_Class_Wide_Type (Parent_Function_Typ)
- and then
- Has_Controlled_Parts (Root_Type (Parent_Function_Typ)))
- or else Has_Controlled_Parts (Etype (Return_Object_Entity))
- or else (Present (Exp)
- and then Has_Controlled_Parts (Etype (Exp))))
+ ((Present (Exp) and then Needs_Finalization (Etype (Exp)))
+ or else
+ (not Present (Exp)
+ and then Needs_Finalization (Etype (Return_Object_Entity))))
then
Append_To (Statements, Move_Final_List);
end if;
----------------
function New_String (Str : String) return chars_ptr is
- -- It's important that this subprogram uses directly the heap to compute
+
+ -- It's important that this subprogram uses the heap directly to compute
-- the result, and doesn't copy the string on the stack, otherwise its
-- use is limited when used from tasks on large strings.
- Result : constant chars_ptr := Memory_Alloc (Str'Length + 1);
+ Result : constant chars_ptr := Memory_Alloc (Str'Length + 1);
+
Result_Array : char_array (1 .. Str'Length + 1);
for Result_Array'Address use To_Address (Result);
pragma Import (Ada, Result_Array);
Count : size_t;
+
begin
To_C
(Item => Str,
Target => Result_Array,
Count => Count,
Append_Nul => True);
-
return Result;
end New_String;
if XE.Loc /= No_Location
and then
(XE.Loc /= Crloc
- or else (Prevt = 'm' and then XE.Typ = 'r'))
+ or else (Prevt = 'm' and then XE.Typ = 'r'))
then
Crloc := XE.Loc;
Prevt := XE.Typ;
-- Normal case, not a label: generate reference
- -- ??? It is too early to generate a reference here even if
- -- the entity is unambiguous, because the tree is not
- -- sufficiently typed at this point for Generate_Reference to
- -- determine whether this reference modifies the denoted object
- -- (because implicit dereferences cannot be identified prior to
- -- full type resolution).
- --
+ -- ??? It is too early to generate a reference here even if the
+ -- entity is unambiguous, because the tree is not sufficiently
+ -- typed at this point for Generate_Reference to determine
+ -- whether this reference modifies the denoted object (because
+ -- implicit dereferences cannot be identified prior to full type
+ -- resolution).
+
-- The Is_Actual_Parameter routine takes care of one of these
-- cases but there are others probably ???
- --
+
-- If the entity is the LHS of an assignment, and is a variable
- -- (rather than a package prefix), we can mark it as a
+ -- (rather than a package prefix), we can mark it as a
-- modification right away, to avoid duplicate references.
else
function Is_LHS (N : Node_Id) return Boolean is
P : constant Node_Id := Parent (N);
+
begin
if Nkind (P) = N_Assignment_Statement then
return Name (P) = N;
projects / gcc.git / commitdiff