aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2011-08-01 15:26:49 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2011-08-01 15:26:49 +0200
commit61c161b2ea14aaabdeac3708e4b5b92d15d94ad1 (patch)
treee9e7f3fc5f9d2161f5205aa86607ca752e9a1718
parent84df40f7680c388bdb85cd859021013dd5c34197 (diff)
downloadgcc-61c161b2ea14aaabdeac3708e4b5b92d15d94ad1.zip
gcc-61c161b2ea14aaabdeac3708e4b5b92d15d94ad1.tar.gz
gcc-61c161b2ea14aaabdeac3708e4b5b92d15d94ad1.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog11
-rw-r--r--gcc/ada/exp_ch11.adb1
-rw-r--r--gcc/ada/exp_ch6.adb32
-rw-r--r--gcc/ada/i-cstrin.adb8
-rw-r--r--gcc/ada/lib-xref.adb2
-rw-r--r--gcc/ada/sem_ch8.adb18
-rw-r--r--gcc/ada/sem_util.adb1
7 files changed, 36 insertions, 37 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1f243eb..df098fc 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+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
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 726af21..d2eed09 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -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));
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 1a5fd13..3f861f2 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -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;
diff --git a/gcc/ada/i-cstrin.adb b/gcc/ada/i-cstrin.adb
index ce74f4f..e35ef36 100644
--- a/gcc/ada/i-cstrin.adb
+++ b/gcc/ada/i-cstrin.adb
@@ -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;
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index c047140..4f440a8 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -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;
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 6c78a5b..2025aa1 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -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
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a5dac14..5fcfd6f 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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;