[multiple changes]

2012-07-23  Ed Schonberg  <schonberg@adacore.com>

	* par-ch6.adb (P_Mode): in Ada 2005, a mode indicator can apply
	to a formal object of an anonymous access type.

2012-07-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Try_Container_Indexing): A user-defined indexing
	aspect can have more than one index, e.g. to describe indexing
	of a multidimensional object.

2012-07-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Apply_Accessibility_Check): Reimplemented. The check is
	now more complex and contains optional finalization part and mandatory
	deallocation part.

2012-07-23  Gary Dismukes  <dismukes@adacore.com>

	* a-cihama.adb, a-cihase.adb, a-cimutr.adb, a-ciorma.adb, a-ciormu.adb,
	a-ciorse.adb, a-coinho.adb, a-coinve.adb, a-cidlli.adb: Unsuppress
	Accessibility_Check for Element_Type allocators.

2012-07-23  Vasiliy Fofanov  <fofanov@adacore.com>

	* projects.texi: Fix typo.

2012-07-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Explicit_Derenference): If prefix is
	overloaded, remove those interpretations whose designated type
	does not match the context, to avoid spurious ambiguities that
	may be caused by the Ada 2012 conversion rule for anonymous
	access types.

From-SVN: r189774

gcc/ada/ChangeLog

+2012-07-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* par-ch6.adb (P_Mode): in Ada 2005, a mode indicator can apply
+	to a formal object of an anonymous access type.
+
+2012-07-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch4.adb (Try_Container_Indexing): A user-defined indexing
+	aspect can have more than one index, e.g. to describe indexing
+	of a multidimensional object.
+
+2012-07-23  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Apply_Accessibility_Check): Reimplemented. The check is
+	now more complex and contains optional finalization part and mandatory
+	deallocation part.
+
+2012-07-23  Gary Dismukes  <dismukes@adacore.com>
+
+	* a-cihama.adb, a-cihase.adb, a-cimutr.adb, a-ciorma.adb, a-ciormu.adb,
+	a-ciorse.adb, a-coinho.adb, a-coinve.adb, a-cidlli.adb: Unsuppress
+	Accessibility_Check for Element_Type allocators.
+
+2012-07-23  Vasiliy Fofanov  <fofanov@adacore.com>
+
+	* projects.texi: Fix typo.
+
+2012-07-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Resolve_Explicit_Derenference): If prefix is
+	overloaded, remove those interpretations whose designated type
+	does not match the context, to avoid spurious ambiguities that
+	may be caused by the Ada 2012 conversion rule for anonymous
+	access types.
+
 2012-07-23  Vincent Celier  <celier@adacore.com>
 
 	* g-spitbo.adb (Substr (String)): Return full string and do not

gcc/ada/a-cidlli.adb

@@ -888,6 +888,13 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       end if;
 
       declare
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
+         --  allocator in the loop below, because the one in this block would
+         --  have failed already.
+
          Element : Element_Access := new Element_Type'(New_Item);
       begin
          New_Node := new Node_Type'(Element, null, null);
@@ -1461,8 +1468,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       pragma Assert (Vet (Position), "bad cursor in Replace_Element");
 
       declare
-         X : Element_Access := Position.Node.Element;
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
 
+         X : Element_Access := Position.Node.Element;
       begin
          Position.Node.Element := new Element_Type'(New_Item);
          Free (X);

gcc/ada/a-cihama.adb

@@ -694,6 +694,11 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
          Position.Node.Key := new Key_Type'(Key);
 
+         declare
+            pragma Unsuppress (Accessibility_Check);
+            --  The element allocator may need an accessibility check in the
+            --  case the actual type is class-wide or has access discriminants
+            --  (see RM 4.8(10.1) and AI12-0035).
          begin
             Position.Node.Element := new Element_Type'(New_Item);
          exception
@@ -731,6 +736,11 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
          K  : Key_Access := new Key_Type'(Key);
          E  : Element_Access;
 
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
+
       begin
          E := new Element_Type'(New_Item);
          return new Node_Type'(K, E, Next);
@@ -1166,6 +1176,11 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
       Node.Key := new Key_Type'(Key);
 
+      declare
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
       begin
          Node.Element := new Element_Type'(New_Item);
       exception
@@ -1215,6 +1230,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       declare
          X : Element_Access := Position.Node.Element;
 
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
       begin
          Position.Node.Element := new Element_Type'(New_Item);
          Free_Element (X);

gcc/ada/a-cihase.adb

@@ -185,6 +185,11 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
    procedure Assign (Node : Node_Access; Item : Element_Type) is
       X : Element_Access := Node.Element;
+
+      pragma Unsuppress (Accessibility_Check);
+      --  The element allocator may need an accessibility check in the case the
+      --  actual type is class-wide or has access discriminants (RM 4.8(10.1)
+      --  and AI12-0035).
    begin
       Node.Element := new Element_Type'(Item);
       Free_Element (X);
@@ -807,7 +812,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
          X := Position.Node.Element;
 
-         Position.Node.Element := new Element_Type'(New_Item);
+         declare
+            pragma Unsuppress (Accessibility_Check);
+            --  The element allocator may need an accessibility check in the
+            --  case the actual type is class-wide or has access discriminants
+            --  (see RM 4.8(10.1) and AI12-0035).
+         begin
+            Position.Node.Element := new Element_Type'(New_Item);
+         end;
 
          Free_Element (X);
       end if;
@@ -863,6 +875,11 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       --------------
 
       function New_Node (Next : Node_Access) return Node_Access is
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
+
          Element : Element_Access := new Element_Type'(New_Item);
       begin
          return new Node_Type'(Element, Next);
@@ -1317,7 +1334,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
       X := Node.Element;
 
-      Node.Element := new Element_Type'(New_Item);
+      declare
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
+      begin
+         Node.Element := new Element_Type'(New_Item);
+      end;
 
       Free_Element (X);
    end Replace;

gcc/ada/a-cimutr.adb

@@ -291,7 +291,17 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
            with "attempt to tamper with cursors (tree is busy)";
       end if;
 
-      Element := new Element_Type'(New_Item);
+      declare
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
+         --  allocator in the loop below, because the one in this block would
+         --  have failed already.
+      begin
+         Element := new Element_Type'(New_Item);
+      end;
+
       First := new Tree_Node_Type'(Parent  => Parent.Node,
                                    Element => Element,
                                    others  => <>);
@@ -1240,7 +1250,17 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
 
       Position.Container := Parent.Container;
 
-      Element := new Element_Type'(New_Item);
+      declare
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
+         --  allocator in the loop below, because the one in this block would
+         --  have failed already.
+      begin
+         Element := new Element_Type'(New_Item);
+      end;
+
       Position.Node := new Tree_Node_Type'(Parent  => Parent.Node,
                                            Element => Element,
                                            others  => <>);
@@ -1805,7 +1825,17 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
            with "attempt to tamper with cursors (tree is busy)";
       end if;
 
-      Element := new Element_Type'(New_Item);
+      declare
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
+         --  allocator in the loop below, because the one in this block would
+         --  have failed already.
+      begin
+         Element := new Element_Type'(New_Item);
+      end;
+
       First := new Tree_Node_Type'(Parent  => Parent.Node,
                                    Element => Element,
                                    others  => <>);
@@ -2163,7 +2193,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
            with "attempt to tamper with elements (tree is locked)";
       end if;
 
-      E := new Element_Type'(New_Item);
+      declare
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
+      begin
+         E := new Element_Type'(New_Item);
+      end;
 
       X := Position.Node.Element;
       Position.Node.Element := E;

gcc/ada/a-ciorma.adb

@@ -812,6 +812,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
          Position.Node.Key := new Key_Type'(Key);
 
+         declare
+            pragma Unsuppress (Accessibility_Check);
+            --  The element allocator may need an accessibility check in the
+            --  case the actual type is class-wide or has access discriminants
+            --  (see RM 4.8(10.1) and AI12-0035).
          begin
             Position.Node.Element := new Element_Type'(New_Item);
          exception
@@ -852,6 +857,10 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       function New_Node return Node_Access is
          Node : Node_Access := new Node_Type;
 
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
       begin
          Node.Key := new Key_Type'(Key);
          Node.Element := new Element_Type'(New_Item);
@@ -1492,6 +1501,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
       Node.Key := new Key_Type'(Key);
 
+      declare
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
       begin
          Node.Element := new Element_Type'(New_Item);
       exception
@@ -1542,6 +1556,10 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       declare
          X : Element_Access := Position.Node.Element;
 
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
       begin
          Position.Node.Element := new Element_Type'(New_Item);
          Free_Element (X);

gcc/ada/a-ciormu.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1167,6 +1167,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       --------------
 
       function New_Node return Node_Access is
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
+
          Element : Element_Access := new Element_Type'(New_Item);
 
       begin
@@ -1768,6 +1773,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
          declare
             X : Element_Access := Node.Element;
+
+            pragma Unsuppress (Accessibility_Check);
+            --  The element allocator may need an accessibility check in the
+            --  case the actual type is class-wide or has access discriminants
+            --  (see RM 4.8(10.1) and AI12-0035).
          begin
             Node.Element := new Element_Type'(Item);
             Free_Element (X);
@@ -1793,6 +1803,10 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
          --------------
 
          function New_Node return Node_Access is
+            pragma Unsuppress (Accessibility_Check);
+            --  The element allocator may need an accessibility check in the
+            --  case the actual type is class-wide or has access discriminants
+            --  (see RM 4.8(10.1) and AI12-0035).
          begin
             Node.Element := new Element_Type'(Item);  -- OK if fails
             Node.Color := Red_Black_Trees.Red;

gcc/ada/a-ciorse.adb

@@ -1173,9 +1173,16 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
               "attempt to tamper with elements (set is locked)";
          end if;
 
-         X := Position.Node.Element;
-         Position.Node.Element := new Element_Type'(New_Item);
-         Free_Element (X);
+         declare
+            pragma Unsuppress (Accessibility_Check);
+            --  The element allocator may need an accessibility check in the
+            --  case the actual type is class-wide or has access discriminants
+            --  (see RM 4.8(10.1) and AI12-0035).
+         begin
+            X := Position.Node.Element;
+            Position.Node.Element := new Element_Type'(New_Item);
+            Free_Element (X);
+         end;
       end if;
    end Include;
 
@@ -1238,6 +1245,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       --------------
 
       function New_Node return Node_Access is
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
+
          Element : Element_Access := new Element_Type'(New_Item);
 
       begin
@@ -1818,9 +1830,16 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
            "attempt to tamper with elements (set is locked)";
       end if;
 
-      X := Node.Element;
-      Node.Element := new Element_Type'(New_Item);
-      Free_Element (X);
+      declare
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
+      begin
+         X := Node.Element;
+         Node.Element := new Element_Type'(New_Item);
+         Free_Element (X);
+      end;
    end Replace;
 
    ---------------------
@@ -1854,6 +1873,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       --------------
 
       function New_Node return Node_Access is
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  the actual type is class-wide or has access discriminants (see
+         --  RM 4.8(10.1) and AI12-0035).
       begin
          Node.Element := new Element_Type'(Item);  -- OK if fails
          Node.Color := Red;
@@ -1883,8 +1906,15 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
               "attempt to tamper with elements (set is locked)";
          end if;
 
-         Node.Element := new Element_Type'(Item);
-         Free_Element (X);
+         declare
+            pragma Unsuppress (Accessibility_Check);
+            --  The element allocator may need an accessibility check in the
+            --  case the actual type is class-wide or has access discriminants
+            --  (see RM 4.8(10.1) and AI12-0035).
+         begin
+            Node.Element := new Element_Type'(Item);
+            Free_Element (X);
+         end;
 
          return;
       end if;
@@ -1901,8 +1931,15 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
                  "attempt to tamper with elements (set is locked)";
             end if;
 
-            Node.Element := new Element_Type'(Item);
-            Free_Element (X);
+            declare
+               pragma Unsuppress (Accessibility_Check);
+               --  The element allocator may need an accessibility check in the
+               --  case actual type is class-wide or has access discriminants
+               --  (see RM 4.8(10.1) and AI12-0035).
+            begin
+               Node.Element := new Element_Type'(Item);
+               Free_Element (X);
+            end;
 
             return;
          end if;

gcc/ada/a-coinho.adb

@@ -2,11 +2,11 @@
 --                                                                          --
 --                         GNAT LIBRARY COMPONENTS                          --
 --                                                                          --
---       A D A . C O N T A I N E R S . B O U N D E D _ V E C T O R S        --
+--     A D A . C O N T A I N E R S . I N D E F I N I T E _ H O L D E R S    --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---             Copyright (C) 2011, Free Software Foundation, Inc.           --
+--             Copyright (C) 2012, Free Software Foundation, Inc.           --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -220,8 +220,17 @@ package body Ada.Containers.Indefinite_Holders is
          raise Program_Error with "attempt to tamper with elements";
       end if;
 
-      Free (Container.Element);
-      Container.Element := new Element_Type'(New_Item);
+      declare
+         X : Element_Access := Container.Element;
+
+         pragma Unsuppress (Accessibility_Check);
+         --  Element allocator may need an accessibility check in case actual
+         --  type is class-wide or has access discriminants (RM 4.8(10.1) and
+         --  AI12-0035).
+      begin
+         Container.Element := new Element_Type'(New_Item);
+         Free (X);
+      end;
    end Replace_Element;
 
    ---------------
@@ -229,6 +238,10 @@ package body Ada.Containers.Indefinite_Holders is
    ---------------
 
    function To_Holder (New_Item : Element_Type) return Holder is
+      pragma Unsuppress (Accessibility_Check);
+      --  The element allocator may need an accessibility check in the case the
+      --  actual type is class-wide or has access discriminants (RM 4.8(10.1)
+      --  and AI12-0035).
    begin
       return (AF.Controlled with new Element_Type'(New_Item), 0);
    end To_Holder;

gcc/ada/a-coinve.adb

@@ -1698,7 +1698,14 @@ package body Ada.Containers.Indefinite_Vectors is
             --  value, in case the allocation fails (either because there is no
             --  storage available, or because element initialization fails).
 
-            Container.Elements.EA (Idx) := new Element_Type'(New_Item);
+            declare
+               pragma Unsuppress (Accessibility_Check);
+               --  The element allocator may need an accessibility check in the
+               --  case actual type is class-wide or has access discriminants
+               --  (see RM 4.8(10.1) and AI12-0035).
+            begin
+               Container.Elements.EA (Idx) := new Element_Type'(New_Item);
+            end;
 
             --  The allocation of the element succeeded, so it is now safe to
             --  update the Last index, restoring container invariants.
@@ -1744,7 +1751,14 @@ package body Ada.Containers.Indefinite_Vectors is
                   --  because there is no storage available, or because element
                   --  initialization fails).
 
-                  E (Idx) := new Element_Type'(New_Item);
+                  declare
+                     pragma Unsuppress (Accessibility_Check);
+                     --  The element allocator may need an accessibility check
+                     --  in case the actual type is class-wide or has access
+                     --  discriminants (see RM 4.8(10.1) and AI12-0035).
+                  begin
+                     E (Idx) := new Element_Type'(New_Item);
+                  end;
 
                   --  The allocation of the element succeeded, so it is now
                   --  safe to update the Last index, restoring container
@@ -1780,6 +1794,11 @@ package body Ada.Containers.Indefinite_Vectors is
                --  K always has a value if the exception handler triggers.
 
                K := Before;
+               declare
+                  pragma Unsuppress (Accessibility_Check);
+                  --  The element allocator may need an accessibility check in
+                  --  the case the actual type is class-wide or has access
+                  --  discriminants (see RM 4.8(10.1) and AI12-0035).
                begin
                   while K < Index loop
                      E (K) := new Element_Type'(New_Item);
@@ -1885,7 +1904,14 @@ package body Ada.Containers.Indefinite_Vectors is
                --  because there is no storage available, or because element
                --  initialization fails).
 
-               Dst.EA (Idx) := new Element_Type'(New_Item);
+               declare
+                  pragma Unsuppress (Accessibility_Check);
+                  --  The element allocator may need an accessibility check in
+                  --  the case the actual type is class-wide or has access
+                  --  discriminants (see RM 4.8(10.1) and AI12-0035).
+               begin
+                  Dst.EA (Idx) := new Element_Type'(New_Item);
+               end;
 
                --  The allocation of the element succeeded, so it is now safe
                --  to update the Last index, restoring container invariants.
@@ -1925,7 +1951,14 @@ package body Ada.Containers.Indefinite_Vectors is
                --  already been updated), so if this allocation fails we simply
                --  let it propagate.
 
-               Dst.EA (Idx) := new Element_Type'(New_Item);
+               declare
+                  pragma Unsuppress (Accessibility_Check);
+                  --  The element allocator may need an accessibility check in
+                  --  the case the actual type is class-wide or has access
+                  --  discriminants (see RM 4.8(10.1) and AI12-0035).
+               begin
+                  Dst.EA (Idx) := new Element_Type'(New_Item);
+               end;
             end loop;
          end if;
       end;
@@ -3174,6 +3207,11 @@ package body Ada.Containers.Indefinite_Vectors is
 
       declare
          X : Element_Access := Container.Elements.EA (Index);
+
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  where the actual type is class-wide or has access discriminants
+         --  (see RM 4.8(10.1) and AI12-0035).
       begin
          Container.Elements.EA (Index) := new Element_Type'(New_Item);
          Free (X);
@@ -3205,6 +3243,11 @@ package body Ada.Containers.Indefinite_Vectors is
 
       declare
          X : Element_Access := Container.Elements.EA (Position.Index);
+
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  where the actual type is class-wide or has access discriminants
+         --  (see RM 4.8(10.1) and AI12-0035).
       begin
          Container.Elements.EA (Position.Index) := new Element_Type'(New_Item);
          Free (X);
@@ -3949,6 +3992,11 @@ package body Ada.Containers.Indefinite_Vectors is
 
       Last := Index_Type'First;
 
+      declare
+         pragma Unsuppress (Accessibility_Check);
+         --  The element allocator may need an accessibility check in the case
+         --  where the actual type is class-wide or has access discriminants
+         --  (see RM 4.8(10.1) and AI12-0035).
       begin
          loop
             Elements.EA (Last) := new Element_Type'(New_Item);

gcc/ada/exp_ch4.adb

@@ -659,7 +659,7 @@ package body Exp_Ch4 is
       --  Ada 2005 (AI-344): For an allocator with a class-wide designated
       --  type, generate an accessibility check to verify that the level of the
       --  type of the created object is not deeper than the level of the access
-      --  type. If the type of the qualified expression is class- wide, then
+      --  type. If the type of the qualified expression is class-wide, then
       --  always generate the check (except in the case where it is known to be
       --  unnecessary, see comment below). Otherwise, only generate the check
       --  if the level of the qualified expression type is statically deeper
@@ -690,7 +690,11 @@ package body Exp_Ch4 is
         (Ref            : Node_Id;
          Built_In_Place : Boolean := False)
       is
-         New_Node : Node_Id;
+         Pool_Id   : constant Entity_Id := Associated_Storage_Pool (PtrT);
+         Cond      : Node_Id;
+         Free_Stmt : Node_Id;
+         Obj_Ref   : Node_Id;
+         Stmts     : List_Id;
 
       begin
          if Ada_Version >= Ada_2005
@@ -701,6 +705,8 @@ package body Exp_Ch4 is
                or else
                  (Is_Class_Wide_Type (Etype (Exp))
                    and then Scope (PtrT) /= Current_Scope))
+           and then
+             (Tagged_Type_Expansion or else VM_Target /= No_VM)
          then
             --  If the allocator was built in place, Ref is already a reference
             --  to the access object initialized to the result of the allocator
@@ -712,39 +718,109 @@ package body Exp_Ch4 is
 
             if Built_In_Place then
                Remove_Side_Effects (Ref);
-               New_Node := New_Copy (Ref);
+               Obj_Ref := New_Copy (Ref);
             else
-               New_Node := New_Reference_To (Ref, Loc);
+               Obj_Ref := New_Reference_To (Ref, Loc);
+            end if;
+
+            --  Step 1: Create the object clean up code
+
+            Stmts := New_List;
+
+            --  Create an explicit free statement to clean up the allocated
+            --  object in case the accessibility check fails. Generate:
+
+            --    Free (Obj_Ref);
+
+            Free_Stmt := Make_Free_Statement (Loc, New_Copy (Obj_Ref));
+            Set_Storage_Pool (Free_Stmt, Pool_Id);
+
+            Append_To (Stmts, Free_Stmt);
+
+            --  Finalize the object (if applicable), but wrap the call inside
+            --  a block to ensure that the object would still be deallocated in
+            --  case the finalization fails. Generate:
+
+            --    begin
+            --       [Deep_]Finalize (Obj_Ref.all);
+            --    exception
+            --       when others =>
+            --          Free (Obj_Ref);
+            --          raise;
+            --    end;
+
+            if Needs_Finalization (DesigT) then
+               Prepend_To (Stmts,
+                 Make_Block_Statement (Loc,
+                   Handled_Statement_Sequence =>
+                     Make_Handled_Sequence_Of_Statements (Loc,
+                       Statements => New_List (
+                         Make_Final_Call (
+                           Obj_Ref =>
+                             Make_Explicit_Dereference (Loc,
+                               Prefix => New_Copy (Obj_Ref)),
+                           Typ     => DesigT)),
+
+                     Exception_Handlers => New_List (
+                       Make_Exception_Handler (Loc,
+                         Exception_Choices => New_List (
+                           Make_Others_Choice (Loc)),
+                         Statements        => New_List (
+                           New_Copy_Tree (Free_Stmt),
+                           Make_Raise_Statement (Loc)))))));
             end if;
 
-            New_Node :=
+            --  Signal the accessibility failure through a Program_Error
+
+            Append_To (Stmts,
+              Make_Raise_Program_Error (Loc,
+                Condition => New_Reference_To (Standard_True, Loc),
+                Reason    => PE_Accessibility_Check_Failed));
+
+            --  Step 2: Create the accessibility comparison
+
+            --  Generate:
+            --    Ref'Tag
+
+            Obj_Ref :=
               Make_Attribute_Reference (Loc,
-                Prefix         => New_Node,
+                Prefix         => Obj_Ref,
                 Attribute_Name => Name_Tag);
 
+            --  For tagged types, determine the accessibility level by looking
+            --  at the type specific data of the dispatch table. Generate:
+
+            --    Type_Specific_Data (Address (Ref'Tag)).Access_Level
+
             if Tagged_Type_Expansion then
-               New_Node := Build_Get_Access_Level (Loc, New_Node);
+               Cond := Build_Get_Access_Level (Loc, Obj_Ref);
 
-            elsif VM_Target /= No_VM then
-               New_Node :=
-                 Make_Function_Call (Loc,
-                   Name => New_Reference_To (RTE (RE_Get_Access_Level), Loc),
-                   Parameter_Associations => New_List (New_Node));
+            --  Use a runtime call to determine the accessibility level when
+            --  compiling on virtual machine targets. Generate:
 
-            --  Cannot generate the runtime check
+            --    Get_Access_Level (Ref'Tag)
 
             else
-               return;
+               Cond :=
+                 Make_Function_Call (Loc,
+                   Name                   =>
+                     New_Reference_To (RTE (RE_Get_Access_Level), Loc),
+                   Parameter_Associations => New_List (Obj_Ref));
             end if;
 
+            Cond :=
+              Make_Op_Gt (Loc,
+                Left_Opnd  => Cond,
+                Right_Opnd =>
+                  Make_Integer_Literal (Loc, Type_Access_Level (PtrT)));
+
+            --  Due to the complexity and side effects of the check, utilize an
+            --  if statement instead of the regular Program_Error circuitry.
+
             Insert_Action (N,
-              Make_Raise_Program_Error (Loc,
-                Condition =>
-                  Make_Op_Gt (Loc,
-                    Left_Opnd  => New_Node,
-                    Right_Opnd =>
-                      Make_Integer_Literal (Loc, Type_Access_Level (PtrT))),
-                Reason => PE_Accessibility_Check_Failed));
+              Make_If_Statement (Loc,
+                Condition       => Cond,
+                Then_Statements => Stmts));
          end if;
       end Apply_Accessibility_Check;
 

gcc/ada/par-ch6.adb

@@ -1562,7 +1562,12 @@ package body Ch6 is
               ("(style) IN should be omitted");
          end if;
 
-         if Token = Tok_Access then
+         --  Since Ada 2005, formal objects can have an anonymous access type,
+         --  and of course carry a mode indicator.
+
+         if Token = Tok_Access
+           and then Nkind (Node) /= N_Formal_Object_Declaration
+         then
             Error_Msg_SP ("IN not allowed together with ACCESS");
             Scan; -- past ACCESS
          end if;

gcc/ada/projects.texi

@@ -342,8 +342,8 @@ locating the specified source files in the specified source directories.
   is explicitly specified.
   @xref{Naming Schemes}.
 
-@item @code{Source Files}
-  @cindex @code{Source_Files}
+@item @code{Source_Files}
+@cindex @code{Source_Files}
   In some cases, source directories might contain files that should not be
   included in a project. One can specify the explicit list of file names to
   be considered through the @b{Source_Files} attribute.

gcc/ada/sem_ch4.adb

@@ -253,7 +253,7 @@ package body Sem_Ch4 is
    function Try_Container_Indexing
      (N      : Node_Id;
       Prefix : Node_Id;
-      Expr   : Node_Id) return Boolean;
+      Exprs  : List_Id) return Boolean;
    --  AI05-0139: Generalized indexing to support iterators over containers
 
    function Try_Indexed_Call
@@ -2114,7 +2114,7 @@ package body Sem_Ch4 is
             then
                return;
 
-            elsif Try_Container_Indexing (N, P, Exp) then
+            elsif Try_Container_Indexing (N, P, Exprs) then
                return;
 
             elsif Array_Type = Any_Type then
@@ -2276,7 +2276,7 @@ package body Sem_Ch4 is
                   end;
                end if;
 
-            elsif Try_Container_Indexing (N, P, First (Exprs)) then
+            elsif Try_Container_Indexing (N, P, Exprs) then
                return;
 
             end if;
@@ -6475,9 +6475,10 @@ package body Sem_Ch4 is
    function Try_Container_Indexing
      (N      : Node_Id;
       Prefix : Node_Id;
-      Expr   : Node_Id) return Boolean
+      Exprs  : List_Id) return Boolean
    is
       Loc       : constant Source_Ptr := Sloc (N);
+      Assoc     : List_Id;
       Disc      : Entity_Id;
       Func      : Entity_Id;
       Func_Name : Node_Id;
@@ -6508,19 +6509,34 @@ package body Sem_Ch4 is
          if Has_Implicit_Dereference (Etype (Prefix)) then
             Build_Explicit_Dereference
               (Prefix, First_Discriminant (Etype (Prefix)));
-            return Try_Container_Indexing (N, Prefix, Expr);
+            return Try_Container_Indexing (N, Prefix, Exprs);
 
          else
             return False;
          end if;
       end if;
 
+      Assoc := New_List (Relocate_Node (Prefix));
+
+      --  A generalized iterator may have nore than one index expression, so
+      --  transfer all of them to the argument list to be used in the call.
+
+      declare
+         Arg : Node_Id;
+
+      begin
+         Arg := First (Exprs);
+         while Present (Arg) loop
+            Append (Relocate_Node (Arg), Assoc);
+            Next (Arg);
+         end loop;
+      end;
+
       if not Is_Overloaded (Func_Name) then
          Func := Entity (Func_Name);
          Indexing := Make_Function_Call (Loc,
            Name => New_Occurrence_Of (Func, Loc),
-           Parameter_Associations =>
-             New_List (Relocate_Node (Prefix), Relocate_Node (Expr)));
+           Parameter_Associations => Assoc);
          Rewrite (N, Indexing);
          Analyze (N);
 
@@ -6544,8 +6560,7 @@ package body Sem_Ch4 is
       else
          Indexing := Make_Function_Call (Loc,
            Name => Make_Identifier (Loc, Chars (Func_Name)),
-           Parameter_Associations =>
-             New_List (Relocate_Node (Prefix), Relocate_Node (Expr)));
+           Parameter_Associations => Assoc);
 
          Rewrite (N, Indexing);
 
@@ -6586,7 +6601,8 @@ package body Sem_Ch4 is
       end if;
 
       if Etype (N) = Any_Type then
-         Error_Msg_NE ("container cannot be indexed with&", N, Etype (Expr));
+         Error_Msg_NE ("container cannot be indexed with&",
+           N, Etype (First (Exprs)));
          Rewrite (N, New_Occurrence_Of (Any_Id, Loc));
       else
          Analyze (N);

gcc/ada/sem_res.adb

@@ -7057,11 +7057,16 @@ package body Sem_Res is
       Loc   : constant Source_Ptr := Sloc (N);
       New_N : Node_Id;
       P     : constant Node_Id := Prefix (N);
+
+      P_Typ : Entity_Id;
+      --  The candidate prefix type, if overloaded
+
       I     : Interp_Index;
       It    : Interp;
 
    begin
       Check_Fully_Declared_Prefix (Typ, P);
+      P_Typ := Empty;
 
       if Is_Overloaded (P) then
 
@@ -7069,14 +7074,28 @@ package body Sem_Res is
          --  designated type.
 
          Get_First_Interp (P, I, It);
+
          while Present (It.Typ) loop
-            exit when Is_Access_Type (It.Typ)
-              and then Covers (Typ, Designated_Type (It.Typ));
+            if Is_Access_Type (It.Typ)
+              and then Covers (Typ, Designated_Type (It.Typ))
+            then
+               P_Typ := It.Typ;
+
+            --  Remove access types that do not match, but preserve access
+            --  to subprogram interpretations, in case a further dereference
+            --  is needed (see below).
+
+            elsif Ekind (It.Typ) /= E_Access_Subprogram_Type then
+               Remove_Interp (I);
+            end if;
+
             Get_Next_Interp (I, It);
          end loop;
 
-         if Present (It.Typ) then
-            Resolve (P, It.Typ);
+         if Present (P_Typ) then
+            Resolve (P, P_Typ);
+            Set_Etype (N, Designated_Type (P_Typ));
+
          else
             --  If no interpretation covers the designated type of the prefix,
             --  this is the pathological case where not all implementations of
@@ -7107,9 +7126,9 @@ package body Sem_Res is
             return;
          end if;
 
-         Set_Etype (N, Designated_Type (It.Typ));
-
       else
+         --  If not overloaded, resolve P with its own type
+
          Resolve (P);
       end if;