[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0e63938393517be130394637770faec157e660b5..47c186cd77c2dba17134f9ec0cd4f4f058ff9ef3 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+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>
 
        * 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 23d8d9766c068b68b9ee5bbf8944cf93cc0f3f9b..b6440f9f58b98e4079de3c28b60b400840705e37 100644 (file)
--- 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 2354b988a428e6c0949b24f89e8467eadae4a1c1..b820f4ddcc7e19dca22e41cb2fa21c3669caf7b9 100644 (file)
--- 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 fd5c01f0f2ff445764a8e18e27efb3f7b1f021c0..2151cf8b998ab9a0cd12b8dc31c7e804295f73bd 100644 (file)
--- 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 2b929575a95f84d7611a4f41c68cb6385c4969fc..d5a798043fc2c78690a479a6e9632d0b7d893145 100644 (file)
--- 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