2011-11-07 Yannick Moy <moy@adacore.com>

	* sem_util.adb (Note_Possible_Modification): In Alfa mode,
	generate a reference for a modification even when the modification
	does not come from source.

2011-11-07  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_Iterator_Loop): For the "of" iterator form,
	use the indexing attributes rather than the Element function,
	to obtain variable references.
	* sem_ch4.adb (Try_Container_Indexing): Code cleanup. Use
	Find_Aspect rather than iterating over representation
	items. Improve error message.
	* a-cohama.adb, a-cohama.ads Update to latest RM, with two versions
	of Reference functions.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181093 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 84 insertions, 47 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f0f5bf95394..c24abece38a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,22 @@
 2011-11-07  Yannick Moy  <moy@adacore.com>
 
+	* sem_util.adb (Note_Possible_Modification): In Alfa mode,
+	generate a reference for a modification even when the modification
+	does not come from source.
+
+2011-11-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb (Expand_Iterator_Loop): For the "of" iterator form,
+	use the indexing attributes rather than the Element function,
+	to obtain variable references.
+	* sem_ch4.adb (Try_Container_Indexing): Code cleanup. Use
+	Find_Aspect rather than iterating over representation
+	items. Improve error message.
+	* a-cohama.adb, a-cohama.ads Update to latest RM, with two versions
+	of Reference functions.
+
+2011-11-07  Yannick Moy  <moy@adacore.com>
+
 	* sem_util.adb (Unique_Entity): For a parameter on a subprogram
 	body that has a corresponding parameter on the subprogram
 	declaration, define the unique entity as being the declaration
diff --git a/gcc/ada/a-cohama.adb b/gcc/ada/a-cohama.adb
index 20e10e8daf9..bb729889272 100644
--- a/gcc/ada/a-cohama.adb
+++ b/gcc/ada/a-cohama.adb
@@ -845,14 +845,36 @@ package body Ada.Containers.Hashed_Maps is
    -- Reference --
    ---------------
 
-   function Constant_Reference (Container : Map; Key : Key_Type)
-   return Constant_Reference_Type is
+   function Constant_Reference
+     (Container : aliased Map; Position : Cursor)
+   return Constant_Reference_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      return (Element => Element (Position)'Unrestricted_Access);
+   end Constant_Reference;
+
+   function Reference
+     (Container : aliased in out Map; Position : Cursor)
+   return Reference_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      return (Element => Element (Position)'Unrestricted_Access);
+   end Reference;
+
+   function Constant_Reference
+     (Container : aliased Map; Key : Key_Type)
+   return Constant_Reference_Type
+   is
    begin
       return (Element => Container.Element (Key)'Unrestricted_Access);
    end Constant_Reference;
 
-   function Reference (Container : Map; Key : Key_Type)
-   return Reference_Type is
+   function Reference
+     (Container : aliased in out Map; Key : Key_Type)
+   return Reference_Type
+   is
    begin
       return (Element => Container.Element (Key)'Unrestricted_Access);
    end Reference;
diff --git a/gcc/ada/a-cohama.ads b/gcc/ada/a-cohama.ads
index 62773833246..a13d14c2cca 100644
--- a/gcc/ada/a-cohama.ads
+++ b/gcc/ada/a-cohama.ads
@@ -311,10 +311,19 @@ package Ada.Containers.Hashed_Maps is
    for Reference_Type'Read use Read;
 
    function Constant_Reference
-     (Container : Map; Key : Key_Type)    --  SHOULD BE ALIASED
+     (Container : aliased Map; Position : Cursor)
    return Constant_Reference_Type;
 
-   function Reference (Container : Map; Key : Key_Type)
+   function Reference
+     (Container : aliased in out Map; Position : Cursor)
+   return Reference_Type;
+
+   function Constant_Reference
+     (Container : aliased Map; Key : Key_Type)
+   return Constant_Reference_Type;
+
+   function Reference
+     (Container : aliased in out Map; Key : Key_Type)
    return Reference_Type;
 
    procedure Iterate
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index eb23bfd641c..fd75b158449 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -3120,32 +3120,32 @@ package body Exp_Ch5 is
                   end loop;
 
                   --  Generate:
-                  --    Id : Element_Type renames Pack.Element (Cursor);
+                  --    Id : Element_Type renames Container (Cursor);
+                  --  This assumes that the container type has an indexing
+                  --  operation with Cursor. The check that this operation
+                  --  exists is performed in Check_Container_Indexing.
 
                   Decl :=
                     Make_Object_Renaming_Declaration (Loc,
                       Defining_Identifier => Id,
-                      Subtype_Mark        =>
+                      Subtype_Mark     =>
                         New_Reference_To (Element_Type, Loc),
-                      Name                =>
+                      Name             =>
                         Make_Indexed_Component (Loc,
-                          Prefix      => Make_Selected_Component (Loc,
-                              Prefix        => New_Reference_To (Pack, Loc),
-                              Selector_Name =>
-                                Make_Identifier (Loc, Chars => Name_Element)),
+                          Prefix      => Relocate_Node (Container_Arg),
                           Expressions =>
                             New_List (New_Occurrence_Of (Cursor, Loc))));
 
                   --  If the container holds controlled objects, wrap the loop
                   --  statements and element renaming declaration with a block.
-                  --  This ensures that the result of Element (Iterator) is
+                  --  This ensures that the result of Element (Cusor) is
                   --  cleaned up after each iteration of the loop.
 
                   if Needs_Finalization (Element_Type) then
 
                      --  Generate:
                      --    declare
-                     --       Id : Element_Type := Pack.Element (Iterator);
+                     --       Id : Element_Type := Pack.Element (curosr);
                      --    begin
                      --       <original loop statements>
                      --    end;
@@ -3279,9 +3279,11 @@ package body Exp_Ch5 is
 
             --  The Iterator is not modified in the source, but of course will
             --  be updated in the generated code. Indicate that it is actually
-            --  set to prevent spurious warnings.
+            --  set to prevent spurious warnings. Ditto for the Cursor, which
+            --  is modified indirectly in generated code.
 
             Set_Never_Set_In_Source (Iterator, False);
+            Set_Never_Set_In_Source (Cursor, False);
 
             --  If the range of iteration is given by a function call that
             --  returns a container, the finalization actions have been saved
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 1a88e77ede8..c9e81e98905 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6427,38 +6427,20 @@ package body Sem_Ch4 is
       Func      : Entity_Id;
       Func_Name : Node_Id;
       Indexing  : Node_Id;
-      Is_Var    : Boolean;
-      Ritem     : Node_Id;
 
    begin
 
       --  Check whether type has a specified indexing aspect
 
       Func_Name := Empty;
-      Is_Var := False;
 
-      Ritem := First_Rep_Item (Etype (Prefix));
-      while Present (Ritem) loop
-         if Nkind (Ritem) = N_Aspect_Specification then
-
-            --  Prefer Variable_Indexing, but will settle for Constant
-
-            if Get_Aspect_Id (Chars (Identifier (Ritem))) =
-                                                 Aspect_Constant_Indexing
-            then
-               Func_Name := Expression (Ritem);
-
-            elsif Get_Aspect_Id (Chars (Identifier (Ritem))) =
-                                                 Aspect_Variable_Indexing
-            then
-               Func_Name :=  Expression (Ritem);
-               Is_Var := True;
-               exit;
-            end if;
-         end if;
+      if Is_Variable (Prefix) then
+         Func_Name := Find_Aspect (Etype (Prefix), Aspect_Variable_Indexing);
+      end if;
 
-         Next_Rep_Item (Ritem);
-      end loop;
+      if No (Func_Name) then
+         Func_Name := Find_Aspect (Etype (Prefix), Aspect_Constant_Indexing);
+      end if;
 
       --  If aspect does not exist the expression is illegal. Error is
       --  diagnosed in caller.
@@ -6478,12 +6460,6 @@ package body Sem_Ch4 is
          end if;
       end if;
 
-      if Is_Var
-        and then not Is_Variable (Prefix)
-      then
-         Error_Msg_N ("Variable indexing cannot be applied to a constant", N);
-      end if;
-
       if not Is_Overloaded (Func_Name) then
          Func := Entity (Func_Name);
          Indexing := Make_Function_Call (Loc,
@@ -6526,6 +6502,7 @@ package body Sem_Ch4 is
                Analyze_One_Call (N, It.Nam, False, Success);
                if Success then
                   Set_Etype (Name (N), It.Typ);
+                  Set_Entity (Name (N), It.Nam);
 
                   --  Add implicit dereference interpretation
 
@@ -6540,12 +6517,20 @@ package body Sem_Ch4 is
 
                      Next_Discriminant (Disc);
                   end loop;
+                  exit;
                end if;
                Get_Next_Interp (I, It);
             end loop;
          end;
       end if;
 
+      if Etype (N) = Any_Type then
+         Error_Msg_NE ("container cannot be indexed with&", N, Etype (Expr));
+         Rewrite (N, New_Occurrence_Of (Any_Id, Loc));
+      else
+         Analyze (N);
+      end if;
+
       return True;
    end Try_Container_Indexing;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 6fbe3995266..1764da9db02 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10837,7 +10837,9 @@ package body Sem_Util is
                --  source. This excludes, for example, calls to a dispatching
                --  assignment operation when the left-hand side is tagged.
 
-               if Modification_Comes_From_Source then
+               if Modification_Comes_From_Source
+                 or else Alfa_Mode
+               then
                   Generate_Reference (Ent, Exp, 'm');
 
                   --  If the target of the assignment is the bound variable