From 61c161b2ea14aaabdeac3708e4b5b92d15d94ad1 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 1 Aug 2011 15:26:49 +0200 Subject: [PATCH] [multiple changes] 2011-08-01 Robert Dewar * i-cstrin.adb, sem_util.adb, exp_ch11.adb, sem_ch8.adb, lib-xref.adb: Minor reformatting 2011-08-01 Gary Dismukes * 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 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/exp_ch11.adb | 1 + gcc/ada/exp_ch6.adb | 32 ++++++++------------------------ gcc/ada/i-cstrin.adb | 8 +++++--- gcc/ada/lib-xref.adb | 2 +- gcc/ada/sem_ch8.adb | 18 +++++++++--------- gcc/ada/sem_util.adb | 1 + 7 files changed, 36 insertions(+), 37 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1f243eb503dd..df098fcd1fc8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2011-08-01 Robert Dewar + + * i-cstrin.adb, sem_util.adb, exp_ch11.adb, sem_ch8.adb, + lib-xref.adb: Minor reformatting + +2011-08-01 Gary Dismukes + + * 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 * 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 726af2191bc2..d2eed096380c 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 1a5fd1376095..3f861f26b9ff 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 ce74f4fafe4c..e35ef36c9e03 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 c0471407a347..4f440a84d221 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 6c78a5b7f54c..2025aa112a51 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 a5dac143aa84..5fcfd6f786b8 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; -- 2.39.2