[multiple changes]

2010-10-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb: Adjust format of error message.

2010-10-26  Robert Dewar  <dewar@adacore.com>

	* einfo.ads, einfo.adb (OK_To_Reference): Removed, no longer used.
	* exp_util.adb (Side_Effect_Free): Put in safety barrier in code to
	detect renamings to avoid problems with invariants.
	* sem_ch13.adb (Replace_Type_References_Generic): New procedure
	(Build_Invariant_Procedure): Use Replace_Type_Reference_Generic
	(Build_Predicate_Function): Use Replace_Type_Reference_Generic
	* sem_res.adb, sem_ch8.adb, sem_ch4.adb (OK_To_Reference): Remove
	references, flag is no longer set.

From-SVN: r165944

9 files changed, 191 insertions, 195 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cdc66e4..c4ab243 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2010-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch5.adb: Adjust format of error message.
+
+2010-10-26  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.ads, einfo.adb (OK_To_Reference): Removed, no longer used.
+	* exp_util.adb (Side_Effect_Free): Put in safety barrier in code to
+	detect renamings to avoid problems with invariants.
+	* sem_ch13.adb (Replace_Type_References_Generic): New procedure
+	(Build_Invariant_Procedure): Use Replace_Type_Reference_Generic
+	(Build_Predicate_Function): Use Replace_Type_Reference_Generic
+	* sem_res.adb, sem_ch8.adb, sem_ch4.adb (OK_To_Reference): Remove
+	references, flag is no longer set.
+
 2010-10-26  Vincent Celier  <celier@adacore.com>
 
 	* prj.ads (Source_Data): New Boolean component Initialized, defaulted
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 5046397..4c2530a 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -513,10 +513,10 @@ package body Einfo is
    --    Is_Underlying_Record_View       Flag246
    --    OK_To_Rename                    Flag247
    --    Has_Inheritable_Invariants      Flag248
-   --    OK_To_Reference                 Flag249
    --    Has_Predicates                  Flag250
 
    --    (unused)                        Flag151
+   --    (unused)                        Flag249
    --    (unused)                        Flag251
    --    (unused)                        Flag252
    --    (unused)                        Flag253
@@ -2314,11 +2314,6 @@ package body Einfo is
       return Uint10 (Id);
    end Normalized_Position_Max;
 
-   function OK_To_Reference (Id : E) return B is
-   begin
-      return Flag249 (Id);
-   end OK_To_Reference;
-
    function OK_To_Rename (Id : E) return B is
    begin
       pragma Assert (Ekind (Id) = E_Variable);
@@ -4808,11 +4803,6 @@ package body Einfo is
       Set_Uint10 (Id, V);
    end Set_Normalized_Position_Max;
 
-   procedure Set_OK_To_Reference (Id : E; V : B := True) is
-   begin
-      Set_Flag249 (Id, V);
-   end Set_OK_To_Reference;
-
    procedure Set_OK_To_Rename (Id : E; V : B := True) is
    begin
       pragma Assert (Ekind (Id) = E_Variable);
@@ -7517,7 +7507,6 @@ package body Einfo is
       W ("No_Strict_Aliasing",              Flag136 (Id));
       W ("Non_Binary_Modulus",              Flag58  (Id));
       W ("Nonzero_Is_True",                 Flag162 (Id));
-      W ("OK_To_Reference",                 Flag249 (Id));
       W ("OK_To_Rename",                    Flag247 (Id));
       W ("OK_To_Reorder_Components",        Flag239 (Id));
       W ("Optimize_Alignment_Space",        Flag241 (Id));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 851333d..3a0b36a 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3151,12 +3151,6 @@ package Einfo is
 --       Applies to subprograms and subprogram types. Yields the number of
 --       formals as a value of type Pos.
 
---    OK_To_Reference (Flag249)
---       Present in all entities. If set it indicates that a naked reference to
---       the entity is permitted within an expression that is being preanalyzed
---       (for example, a type name may be referenced within the Invariant
---       or Predicate aspect expression for a type).
-
 --    OK_To_Rename (Flag247)
 --       Present only in entities for variables. If this flag is set, it
 --       means that if the entity is used as the initial value of an object
@@ -4739,7 +4733,6 @@ package Einfo is
    --    Needs_Debug_Info                    (Flag147)
    --    Never_Set_In_Source                 (Flag115)
    --    No_Return                           (Flag113)
-   --    OK_To_Reference                     (Flag249)
    --    Overlays_Constant                   (Flag243)
    --    Referenced                          (Flag156)
    --    Referenced_As_LHS                   (Flag36)
@@ -6191,7 +6184,6 @@ package Einfo is
    function Normalized_First_Bit                (Id : E) return U;
    function Normalized_Position                 (Id : E) return U;
    function Normalized_Position_Max             (Id : E) return U;
-   function OK_To_Reference                     (Id : E) return B;
    function OK_To_Rename                        (Id : E) return B;
    function OK_To_Reorder_Components            (Id : E) return B;
    function Optimize_Alignment_Space            (Id : E) return B;
@@ -6779,7 +6771,6 @@ package Einfo is
    procedure Set_Normalized_First_Bit            (Id : E; V : U);
    procedure Set_Normalized_Position             (Id : E; V : U);
    procedure Set_Normalized_Position_Max         (Id : E; V : U);
-   procedure Set_OK_To_Reference                 (Id : E; V : B := True);
    procedure Set_OK_To_Rename                    (Id : E; V : B := True);
    procedure Set_OK_To_Reorder_Components        (Id : E; V : B := True);
    procedure Set_Optimize_Alignment_Space        (Id : E; V : B := True);
@@ -7512,7 +7503,6 @@ package Einfo is
    pragma Inline (Normalized_First_Bit);
    pragma Inline (Normalized_Position);
    pragma Inline (Normalized_Position_Max);
-   pragma Inline (OK_To_Reference);
    pragma Inline (OK_To_Rename);
    pragma Inline (OK_To_Reorder_Components);
    pragma Inline (Optimize_Alignment_Space);
@@ -7909,7 +7899,6 @@ package Einfo is
    pragma Inline (Set_Normalized_Position);
    pragma Inline (Set_Normalized_Position_Max);
    pragma Inline (Set_OK_To_Reorder_Components);
-   pragma Inline (Set_OK_To_Reference);
    pragma Inline (Set_OK_To_Rename);
    pragma Inline (Set_Optimize_Alignment_Space);
    pragma Inline (Set_Optimize_Alignment_Time);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 3a94bef..5fc7d4d 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -4716,7 +4716,14 @@ package body Exp_Util is
          --  some cases, and an assignment can modify the component
          --  designated by N, so we need to create a temporary for it.
 
+         --  The guard testing for Entity being present is needed at least
+         --  in the case of rewritten predicate expressions, and may be
+         --  appropriate elsewhere. Obviously we can't go testing the entity
+         --  field if it does not exist, so it's reasonable to say that this
+         --  is not the renaming case if it does not exist.
+
          elsif Is_Entity_Name (Original_Node (N))
+           and then Present (Entity (Original_Node (N)))
            and then Is_Renaming_Of_Object (Entity (Original_Node (N)))
            and then Ekind (Entity (Original_Node (N))) /= E_Constant
          then
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 594cbce..a46ba87 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -134,6 +134,17 @@ package body Sem_Ch13 is
    --  renaming_as_body. For tagged types, the specification is one of the
    --  primitive specs.
 
+   generic
+      with procedure Replace_Type_Reference (N : Node_Id);
+   procedure Replace_Type_References_Generic (N : Node_Id; TName : Name_Id);
+   --  This is used to scan an expression for a predicate or invariant aspect
+   --  replacing occurrences of the name TName (the name of the subtype to
+   --  which the aspect applies) with appropriate references to the parameter
+   --  of the predicate function or invariant procedure. The procedure passed
+   --  as a generic parameter does the actual replacement of node N, which is
+   --  either a simple direct reference to TName, or a selected component that
+   --  represents an appropriately qualified occurrence of TName.
+
    procedure Set_Biased
      (E      : Entity_Id;
       N      : Node_Id;
@@ -3552,56 +3563,46 @@ package body Sem_Ch13 is
          Assoc : List_Id;
          Str   : String_Id;
 
-         function Replace_Node (N : Node_Id) return Traverse_Result;
-         --  Process single node for traversal to replace type references
+         procedure Replace_Type_Reference (N : Node_Id);
+         --  Replace a single occurrence N of the subtype name with a reference
+         --  to the formal of the predicate function. N can be an identifier
+         --  referencing the subtype, or a selected component, representing an
+         --  appropriately qualified occurrence of the subtype name.
 
-         procedure Replace_Type is new Traverse_Proc (Replace_Node);
-         --  Traverse an expression changing every occurrence of an entity
-         --  reference to type T with a reference to the object argument.
+         procedure Replace_Type_References is
+           new Replace_Type_References_Generic (Replace_Type_Reference);
+         --  Traverse an expression replacing all occurrences of the subtype
+         --  name with appropriate references to the object that is the formal
+         --  parameter of the predicate function.
 
-         ------------------
-         -- Replace_Node --
-         ------------------
+         ----------------------------
+         -- Replace_Type_Reference --
+         ----------------------------
 
-         function Replace_Node (N : Node_Id) return Traverse_Result is
+         procedure Replace_Type_Reference (N : Node_Id) is
          begin
-            --  Case of entity name referencing the type
-
-            if Is_Entity_Name (N)
-              and then Entity (N) = T
-            then
-               --  Invariant'Class, replace with T'Class (obj)
-
-               if Class_Present (Ritem) then
-                  Rewrite (N,
-                    Make_Type_Conversion (Loc,
-                      Subtype_Mark =>
-                        Make_Attribute_Reference (Loc,
-                          Prefix         =>
-                            New_Occurrence_Of (T, Loc),
-                          Attribute_Name => Name_Class),
-                      Expression =>
-                        Make_Identifier (Loc,
-                          Chars => Object_Name)));
-
-               --  Invariant, replace with obj
-
-               else
-                  Rewrite (N,
-                    Make_Identifier (Loc,
-                      Chars => Object_Name));
-               end if;
-
-               --  All done with this node
-
-               return Skip;
+            --  Invariant'Class, replace with T'Class (obj)
+
+            if Class_Present (Ritem) then
+               Rewrite (N,
+                 Make_Type_Conversion (Loc,
+                   Subtype_Mark =>
+                     Make_Attribute_Reference (Loc,
+                       Prefix         =>
+                         New_Occurrence_Of (T, Loc),
+                       Attribute_Name => Name_Class),
+                   Expression =>
+                     Make_Identifier (Loc,
+                       Chars => Object_Name)));
 
-            --  Not an instance of the type entity, keep going
+            --  Invariant, replace with obj
 
             else
-               return OK;
+               Rewrite (N,
+                 Make_Identifier (Loc,
+                   Chars => Object_Name));
             end if;
-         end Replace_Node;
+         end Replace_Type_Reference;
 
       --  Start of processing for Add_Invariants
 
@@ -3642,21 +3643,9 @@ package body Sem_Ch13 is
 
                --  We need to replace any occurrences of the name of the type
                --  with references to the object, converted to type'Class in
-               --  the case of Invariant'Class aspects. We do this by first
-               --  doing a preanalysis, to identify all the entities, then
-               --  we traverse looking for the type entity, and doing the
-               --  necessary substitution. The preanalysis is done with the
-               --  special OK_To_Reference flag set on the type, so that if
-               --  we get an occurrence of this type, it will be reognized
-               --  as legitimate.
-
-               Set_OK_To_Reference (T, True);
-               Preanalyze_Spec_Expression (Exp, Standard_Boolean);
-               Set_OK_To_Reference (T, False);
+               --  the case of Invariant'Class aspects.
 
-               --  Do the traversal
-
-               Replace_Type (Exp);
+               Replace_Type_References (Exp, Chars (T));
 
                --  Build first two arguments for Check pragma
 
@@ -3833,9 +3822,6 @@ package body Sem_Ch13 is
       FDecl : Node_Id;
       FBody : Node_Id;
 
-      TName : constant Name_Id := Chars (Typ);
-      --  Name of the type, used for replacement in predicate expression
-
       Expr : Node_Id;
       --  This is the expression for the return statement in the function. It
       --  is build by connecting the component predicates with AND THEN.
@@ -3911,107 +3897,26 @@ package body Sem_Ch13 is
          Arg1  : Node_Id;
          Arg2  : Node_Id;
 
-         function Replace_Node (N : Node_Id) return Traverse_Result;
-         --  Process single node for traversal to replace type references
+         procedure Replace_Type_Reference (N : Node_Id);
+         --  Replace a single occurrence N of the subtype name with a reference
+         --  to the formal of the predicate function. N can be an identifier
+         --  referencing the subtype, or a selected component, representing an
+         --  appropriately qualified occurrence of the subtype name.
 
-         procedure Replace_Type is new Traverse_Proc (Replace_Node);
+         procedure Replace_Type_References is
+           new Replace_Type_References_Generic (Replace_Type_Reference);
          --  Traverse an expression changing every occurrence of an identifier
-         --  whose name is TName with a reference to the object argument.
+         --  whose name mathches the name of the subtype with a reference to
+         --  the formal parameter of the predicate function.
 
-         ------------------
-         -- Replace_Node --
-         ------------------
-
-         function Replace_Node (N : Node_Id) return Traverse_Result is
-            S : Entity_Id;
-            P : Node_Id;
+         ----------------------------
+         -- Replace_Type_Reference --
+         ----------------------------
 
+         procedure Replace_Type_Reference (N : Node_Id) is
          begin
-            --  Case of identifier
-
-            if Nkind (N) = N_Identifier then
-
-               --  If not the type name, all done with this node
-
-               if Chars (N) /= TName then
-                  return Skip;
-
-               --  Otherwise do the replacement
-
-               else
-                  goto Do_Replace;
-               end if;
-
-               --  Case of selected component (which is what a qualification
-               --  looks like in the unanalyzed tree, which is what we have.
-
-            elsif Nkind (N) = N_Selected_Component then
-
-               --  If selector name is not our type, keeping going (we might
-               --  still have an occurrence of the type in the prefix).
-
-               if Nkind (Selector_Name (N)) /= N_Identifier
-                 or else Chars (Selector_Name (N)) /= TName
-               then
-                  return OK;
-
-               --  Selector name is our type, check qualification
-
-               else
-                  --  Loop through scopes and prefixes, doing comparison
-
-                  S := Current_Scope;
-                  P := Prefix (N);
-                  loop
-                     --  Continue if no more scopes or scope with no name
-
-                     if No (S) or else Nkind (S) not in N_Has_Chars then
-                        return OK;
-                     end if;
-
-                     --  Do replace if prefix is an identifier matching the
-                     --  scope that we are currently looking at.
-
-                     if Nkind (P) = N_Identifier
-                       and then Chars (P) = Chars (S)
-                     then
-                        goto Do_Replace;
-                     end if;
-
-                     --  Go check scope above us if prefix is itself of the
-                     --  form of a selected component, whose selector matches
-                     --  the scope we are currently looking at.
-
-                     if Nkind (P) = N_Selected_Component
-                       and then Nkind (Selector_Name (P)) = N_Identifier
-                       and then Chars (Selector_Name (P)) = Chars (S)
-                     then
-                        S := Scope (S);
-                        P := Prefix (P);
-
-                     --  For anything else, we don't have a match, so keep on
-                     --  going, there are still some weird cases where we may
-                     --  still have a replacement within the prefix.
-
-                     else
-                        return OK;
-                     end if;
-                  end loop;
-               end if;
-
-            --  Continue for any other node kind
-
-            else
-               return OK;
-            end if;
-
-         <<Do_Replace>>
-
-            --  Replace with object
-
             Rewrite (N, Make_Identifier (Loc, Chars => Object_Name));
-            return Skip;
-         end Replace_Node;
+         end Replace_Type_Reference;
 
       --  Start of processing for Add_Predicates
 
@@ -4036,7 +3941,7 @@ package body Sem_Ch13 is
                   --  First We need to replace any occurrences of the name of
                   --  the type with references to the object.
 
-                  Replace_Type (Arg2);
+                  Replace_Type_References (Arg2, Chars (Typ));
 
                   --  OK, replacement complete, now we can add the expression
 
@@ -6751,6 +6656,113 @@ package body Sem_Ch13 is
       return False;
    end Rep_Item_Too_Late;
 
+   -------------------------------------
+   -- Replace_Type_References_Generic --
+   -------------------------------------
+
+   procedure Replace_Type_References_Generic (N : Node_Id; TName : Name_Id) is
+
+      function Replace_Node (N : Node_Id) return Traverse_Result;
+      --  Processes a single node in the traversal procedure below, checking
+      --  if node N should be replaced, and if so, doing the replacement.
+
+      procedure Replace_Type_Refs is new Traverse_Proc (Replace_Node);
+      --  This instantiation provides the body of Replace_Type_References
+
+      ------------------
+      -- Replace_Node --
+      ------------------
+
+      function Replace_Node (N : Node_Id) return Traverse_Result is
+         S : Entity_Id;
+         P : Node_Id;
+
+      begin
+         --  Case of identifier
+
+         if Nkind (N) = N_Identifier then
+
+            --  If not the type name, all done with this node
+
+            if Chars (N) /= TName then
+               return Skip;
+
+            --  Otherwise do the replacement and we are done with this node
+
+            else
+               Replace_Type_Reference (N);
+               return Skip;
+            end if;
+
+         --  Case of selected component (which is what a qualification
+         --  looks like in the unanalyzed tree, which is what we have.
+
+         elsif Nkind (N) = N_Selected_Component then
+
+            --  If selector name is not our type, keeping going (we might
+            --  still have an occurrence of the type in the prefix).
+
+            if Nkind (Selector_Name (N)) /= N_Identifier
+              or else Chars (Selector_Name (N)) /= TName
+            then
+               return OK;
+
+            --  Selector name is our type, check qualification
+
+            else
+               --  Loop through scopes and prefixes, doing comparison
+
+               S := Current_Scope;
+               P := Prefix (N);
+               loop
+                  --  Continue if no more scopes or scope with no name
+
+                  if No (S) or else Nkind (S) not in N_Has_Chars then
+                     return OK;
+                  end if;
+
+                  --  Do replace if prefix is an identifier matching the
+                  --  scope that we are currently looking at.
+
+                  if Nkind (P) = N_Identifier
+                    and then Chars (P) = Chars (S)
+                  then
+                     Replace_Type_Reference (N);
+                     return Skip;
+                  end if;
+
+                  --  Go check scope above us if prefix is itself of the
+                  --  form of a selected component, whose selector matches
+                  --  the scope we are currently looking at.
+
+                  if Nkind (P) = N_Selected_Component
+                    and then Nkind (Selector_Name (P)) = N_Identifier
+                    and then Chars (Selector_Name (P)) = Chars (S)
+                  then
+                     S := Scope (S);
+                     P := Prefix (P);
+
+                  --  For anything else, we don't have a match, so keep on
+                  --  going, there are still some weird cases where we may
+                  --  still have a replacement within the prefix.
+
+                  else
+                     return OK;
+                  end if;
+               end loop;
+            end if;
+
+            --  Continue for any other node kind
+
+         else
+            return OK;
+         end if;
+      end Replace_Node;
+
+   begin
+      Replace_Type_Refs (N);
+   end Replace_Type_References_Generic;
+
    -------------------------
    -- Same_Representation --
    -------------------------
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 604a9b1..8d743f2 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -5584,13 +5584,6 @@ package body Sem_Ch4 is
          return False;
       end if;
 
-      --  If OK_To_Reference is set for the entity, then don't complain, it
-      --  means we are doing a preanalysis in which such complaints are wrong.
-
-      if OK_To_Reference (Entity (Enode)) then
-         return False;
-      end if;
-
       --  Now test the entity we got to see if it is a bad case
 
       case Ekind (Entity (Enode)) is
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index e7091cd..5edc342 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2011,7 +2011,7 @@ package body Sem_Ch5 is
             Set_Etype (Def_Id, Component_Type (Typ));
          else
             Error_Msg_N
-              ("to iterate over the elements of an array, use 'O'F", N);
+              ("to iterate over the elements of an array, use OF", N);
             Set_Etype (Def_Id, Etype (First_Index (Typ)));
          end if;
 
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 0aaa426..9785348 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -5481,9 +5481,6 @@ package body Sem_Ch8 is
 
          --  Reference to type name in predicate/invariant expression
 
-         elsif OK_To_Reference (Etype (P)) then
-            Analyze_Selected_Component (N);
-
          elsif Is_Appropriate_For_Entry_Prefix (P_Type)
            and then not In_Open_Scopes (P_Name)
            and then (not Is_Concurrent_Type (Etype (P_Name))
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e92477e..cf71046 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5971,12 +5971,6 @@ package body Sem_Res is
          then
             null;
 
-         --  Allow reference to type specifically marked as being OK in this
-         --  context (this is used for example for type names in invariants).
-
-         elsif OK_To_Reference (E) then
-            null;
-
          --  Any other use is an eror
 
          else