Commit 33398e3c by Arnaud Charlet

[multiple changes]

2015-10-16  Ed Schonberg  <schonberg@adacore.com>

	* 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  <duff@adacore.com>

	* 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  <moy@adacore.com>

	* sem_util.adb (Is_Object_Reference): Attribute 'Loop_Entry produces
	an object.
	* sem_ch6.adb: Minor fix in comment.

From-SVN: r228897
parent 2a738b34
2015-10-16 Ed Schonberg <schonberg@adacore.com>
* 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 <duff@adacore.com>
* 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 <moy@adacore.com>
* sem_util.adb (Is_Object_Reference): Attribute 'Loop_Entry produces
an object.
* sem_ch6.adb: Minor fix in comment.
2015-10-16 Bob Duff <duff@adacore.com> 2015-10-16 Bob Duff <duff@adacore.com>
* a-contai.ads: Add two check names: Container_Checks and * a-contai.ads: Add two check names: Container_Checks and
......
...@@ -100,20 +100,23 @@ package body Ada.Containers.Vectors is ...@@ -100,20 +100,23 @@ package body Ada.Containers.Vectors is
--------- ---------
overriding function "=" (Left, Right : Vector) return Boolean is overriding function "=" (Left, Right : Vector) return Boolean is
begin
-- Per AI05-0022, the container implementation is required to detect -- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram. -- element tampering by a generic actual subprogram.
declare Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
Lock_Left : With_Lock (Left.TC'Unrestricted_Access); Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
Lock_Right : With_Lock (Right.TC'Unrestricted_Access); begin
Left_Valid : Elements_Array renames if Left.Last /= Right.Last then
Left.Elements.EA (Index_Type'First .. Left.Last); return False;
Right_Valid : Elements_Array renames end if;
Right.Elements.EA (Index_Type'First .. Right.Last);
begin for J in Index_Type range Index_Type'First .. Left.Last loop
return Left_Valid = Right_Valid; if Left.Elements.EA (J) /= Right.Elements.EA (J) then
end; return False;
end if;
end loop;
return True;
end "="; end "=";
------------ ------------
......
...@@ -8706,12 +8706,12 @@ package body Sem_Ch13 is ...@@ -8706,12 +8706,12 @@ package body Sem_Ch13 is
-- Static predicate functions are always side-effect free, and -- Static predicate functions are always side-effect free, and
-- in most cases dynamic predicate functions are as well. Mark -- in most cases dynamic predicate functions are as well. Mark
-- them as such whenever possible, so redundant predicate checks -- them as such whenever possible, so redundant predicate checks
-- can be optimized. -- can be optimized. If there is a variable reference within the
-- expression, the function is not pure.
-- Shouldn't Variable_Ref be True for Side_Effect_Free call ???
if Expander_Active then 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); Set_Is_Inlined (SId);
end if; end if;
end; end;
......
...@@ -2341,13 +2341,12 @@ package body Sem_Ch6 is ...@@ -2341,13 +2341,12 @@ package body Sem_Ch6 is
Item : Node_Id; Item : Node_Id;
begin begin
-- Check for unanalyzed aspects in the body that will generate a -- Check for aspects that may generate a contract
-- contract.
if Present (Aspect_Specifications (N)) then if Present (Aspect_Specifications (N)) then
Item := First (Aspect_Specifications (N)); Item := First (Aspect_Specifications (N));
while Present (Item) loop while Present (Item) loop
if Is_Contract_Annotation (Item) then if Is_Subprogram_Contract_Annotation (Item) then
return True; return True;
end if; end if;
...@@ -2361,7 +2360,7 @@ package body Sem_Ch6 is ...@@ -2361,7 +2360,7 @@ package body Sem_Ch6 is
Item := First (Decls); Item := First (Decls);
while Present (Item) loop while Present (Item) loop
if Nkind (Item) = N_Pragma if Nkind (Item) = N_Pragma
and then Is_Contract_Annotation (Item) and then Is_Subprogram_Contract_Annotation (Item)
then then
return True; return True;
end if; end if;
......
...@@ -12101,12 +12101,15 @@ package body Sem_Util is ...@@ -12101,12 +12101,15 @@ package body Sem_Util is
when N_Function_Call => when N_Function_Call =>
return Etype (N) /= Standard_Void_Type; 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 => when N_Attribute_Reference =>
return return
Nam_In Nam_In (Attribute_Name (N), Name_Input,
(Attribute_Name (N), Name_Input, Name_Old, Name_Result); Name_Loop_Entry,
Name_Old,
Name_Result);
when N_Selected_Component => when N_Selected_Component =>
return return
......
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