From 33398e3c4e7b38f6cf484942fe205be9003017c8 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 16 Oct 2015 15:11:18 +0200 Subject: [PATCH] [multiple changes] 2015-10-16 Ed Schonberg * sem_ch13.adb (Build_Predicate_Functions): The expression for the predicate is side-effect free if it does not contain any variable references. 2015-10-16 Bob Duff * a-convec.adb ("="): Previous version depended on "=" composing, but that doesn't quite work -- we want the "=" operator passed in to the generic. So we need a loop after all. 2015-10-16 Yannick Moy * sem_util.adb (Is_Object_Reference): Attribute 'Loop_Entry produces an object. * sem_ch6.adb: Minor fix in comment. From-SVN: r228897 --- gcc/ada/ChangeLog | 18 ++++++++++++++++++ gcc/ada/a-convec.adb | 25 ++++++++++++++----------- gcc/ada/sem_ch13.adb | 8 ++++---- gcc/ada/sem_ch6.adb | 7 +++---- gcc/ada/sem_util.adb | 9 ++++++--- 5 files changed, 45 insertions(+), 22 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0e639383935..47c186cd77c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2015-10-16 Ed Schonberg + + * sem_ch13.adb (Build_Predicate_Functions): The expression for + the predicate is side-effect free if it does not contain any + variable references. + +2015-10-16 Bob Duff + + * a-convec.adb ("="): Previous version depended + on "=" composing, but that doesn't quite work -- we want the "=" + operator passed in to the generic. So we need a loop after all. + +2015-10-16 Yannick Moy + + * sem_util.adb (Is_Object_Reference): Attribute 'Loop_Entry produces + an object. + * sem_ch6.adb: Minor fix in comment. + 2015-10-16 Bob Duff * a-contai.ads: Add two check names: Container_Checks and diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index 23d8d9766c0..b6440f9f58b 100644 --- a/gcc/ada/a-convec.adb +++ b/gcc/ada/a-convec.adb @@ -100,20 +100,23 @@ package body Ada.Containers.Vectors is --------- overriding function "=" (Left, Right : Vector) return Boolean is - begin -- Per AI05-0022, the container implementation is required to detect -- element tampering by a generic actual subprogram. - declare - Lock_Left : With_Lock (Left.TC'Unrestricted_Access); - Lock_Right : With_Lock (Right.TC'Unrestricted_Access); - Left_Valid : Elements_Array renames - Left.Elements.EA (Index_Type'First .. Left.Last); - Right_Valid : Elements_Array renames - Right.Elements.EA (Index_Type'First .. Right.Last); - begin - return Left_Valid = Right_Valid; - end; + Lock_Left : With_Lock (Left.TC'Unrestricted_Access); + Lock_Right : With_Lock (Right.TC'Unrestricted_Access); + begin + if Left.Last /= Right.Last then + return False; + end if; + + for J in Index_Type range Index_Type'First .. Left.Last loop + if Left.Elements.EA (J) /= Right.Elements.EA (J) then + return False; + end if; + end loop; + + return True; end "="; ------------ diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2354b988a42..b820f4ddcc7 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -8706,12 +8706,12 @@ package body Sem_Ch13 is -- Static predicate functions are always side-effect free, and -- in most cases dynamic predicate functions are as well. Mark -- them as such whenever possible, so redundant predicate checks - -- can be optimized. - - -- Shouldn't Variable_Ref be True for Side_Effect_Free call ??? + -- can be optimized. If there is a variable reference within the + -- expression, the function is not pure. if Expander_Active then - Set_Is_Pure (SId, Side_Effect_Free (Expr)); + Set_Is_Pure (SId, + Side_Effect_Free (Expr, Variable_Ref => True)); Set_Is_Inlined (SId); end if; end; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index fd5c01f0f2f..2151cf8b998 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2341,13 +2341,12 @@ package body Sem_Ch6 is Item : Node_Id; begin - -- Check for unanalyzed aspects in the body that will generate a - -- contract. + -- Check for aspects that may generate a contract if Present (Aspect_Specifications (N)) then Item := First (Aspect_Specifications (N)); while Present (Item) loop - if Is_Contract_Annotation (Item) then + if Is_Subprogram_Contract_Annotation (Item) then return True; end if; @@ -2361,7 +2360,7 @@ package body Sem_Ch6 is Item := First (Decls); while Present (Item) loop if Nkind (Item) = N_Pragma - and then Is_Contract_Annotation (Item) + and then Is_Subprogram_Contract_Annotation (Item) then return True; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 2b929575a95..d5a798043fc 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12101,12 +12101,15 @@ package body Sem_Util is when N_Function_Call => return Etype (N) /= Standard_Void_Type; - -- Attributes 'Input, 'Old and 'Result produce objects + -- Attributes 'Input, 'Loop_Entry, 'Old and 'Result produce + -- objects. when N_Attribute_Reference => return - Nam_In - (Attribute_Name (N), Name_Input, Name_Old, Name_Result); + Nam_In (Attribute_Name (N), Name_Input, + Name_Loop_Entry, + Name_Old, + Name_Result); when N_Selected_Component => return -- 2.30.2