Commit 61c161b2 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r177030
parent 84df40f7
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
......
......@@ -1532,6 +1532,7 @@ package body Exp_Ch11 is
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));
......
......@@ -4250,7 +4250,6 @@ package body Exp_Ch6 is
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);
......@@ -4260,10 +4259,6 @@ package body Exp_Ch6 is
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:
......@@ -4278,17 +4273,6 @@ package body Exp_Ch6 is
-- 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 --
---------------------------
......@@ -4417,17 +4401,17 @@ package body Exp_Ch6 is
-- 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;
......
......@@ -139,23 +139,25 @@ package body Interfaces.C.Strings is
----------------
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;
......
......@@ -2204,7 +2204,7 @@ package body Lib.Xref is
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;
......
......@@ -4565,18 +4565,18 @@ package body Sem_Ch8 is
-- 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
......
......@@ -6662,6 +6662,7 @@ package body Sem_Util is
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;
......
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