[multiple changes]

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb: Additional semantic checks for aspects involved in
	iterators.

2011-08-29  Matthew Heaney  <heaney@adacore.com>

	* a-comutr.ads, a-comutr.adb, a-cimutr.ads, a-cimutr.adb,
	a-cbmutr.ads, a-cbmutr.adb (Find_In_Subtree): Remove superfluous
	Container parameter.
	(Ancestor_Find): ditto.

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* par-endh.adb: Minor reformatting.

From-SVN: r178190

9 files changed, 376 insertions, 121 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5d533d3..6799af8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,7 +1,19 @@
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb: Additional semantic checks for aspects involved in
+	iterators.
+
+2011-08-29  Matthew Heaney  <heaney@adacore.com>
+
+	* a-comutr.ads, a-comutr.adb, a-cimutr.ads, a-cimutr.adb,
+	a-cbmutr.ads, a-cbmutr.adb (Find_In_Subtree): Remove superfluous
+	Container parameter.
+	(Ancestor_Find): ditto.
+
 2011-08-29  Thomas Quinot  <quinot@adacore.com>
 
 	* par-endh.adb: Minor reformatting.
-z
+
 2011-08-29  Tristan Gingold  <gingold@adacore.com>
 
 	* a-exexpr-gcc.adb (Unwind_Action) Rewrite as an integer with constants.
diff --git a/gcc/ada/a-cbmutr.adb b/gcc/ada/a-cbmutr.adb
index da64261..e206e98 100644
--- a/gcc/ada/a-cbmutr.adb
+++ b/gcc/ada/a-cbmutr.adb
@@ -286,21 +286,21 @@ package body Ada.Containers.Bounded_Multiway_Trees is
    -------------------
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
-      R : constant Count_Type := Root_Node (Container);
-      N : Count_Type;
+      R, N : Count_Type;
 
    begin
       if Position = No_Element then
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented-out pending ruling by ARG.  ???
+
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
 
       --  AI-0136 says to raise PE if Position equals the root node. This does
       --  not seem correct, as this value is just the limiting condition of the
@@ -311,13 +311,14 @@ package body Ada.Containers.Bounded_Multiway_Trees is
       --     raise Program_Error with "Position cursor designates root";
       --  end if;
 
+      R := Root_Node (Position.Container.all);
       N := Position.Node;
       while N /= R loop
-         if Container.Elements (N) = Item then
-            return Cursor'(Container'Unrestricted_Access, N);
+         if Position.Container.Elements (N) = Item then
+            return Cursor'(Position.Container, N);
          end if;
 
-         N := Container.Nodes (N).Parent;
+         N := Position.Container.Nodes (N).Parent;
       end loop;
 
       return No_Element;
@@ -1289,9 +1290,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is
    ---------------------
 
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
       Result : Count_Type;
 
@@ -1300,27 +1300,35 @@ package body Ada.Containers.Bounded_Multiway_Trees is
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented-out pending ruling by ARG.  ???
 
-      if Container.Count = 0 then
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
+
+      if Position.Container.Count = 0 then
          pragma Assert (Is_Root (Position));
          return No_Element;
       end if;
 
       if Is_Root (Position) then
-         Result := Find_In_Children (Container, Position.Node, Item);
+         Result := Find_In_Children
+                     (Container => Position.Container.all,
+                      Subtree   => Position.Node,
+                      Item      => Item);
 
       else
-         Result := Find_In_Subtree (Container, Position.Node, Item);
+         Result := Find_In_Subtree
+                     (Container => Position.Container.all,
+                      Subtree   => Position.Node,
+                      Item      => Item);
       end if;
 
       if Result = 0 then
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Result);
+      return Cursor'(Position.Container, Result);
    end Find_In_Subtree;
 
    function Find_In_Subtree
diff --git a/gcc/ada/a-cbmutr.ads b/gcc/ada/a-cbmutr.ads
index b62e67f..818cde2 100644
--- a/gcc/ada/a-cbmutr.ads
+++ b/gcc/ada/a-cbmutr.ads
@@ -113,22 +113,36 @@ package Ada.Containers.Bounded_Multiway_Trees is
       Item      : Element_Type) return Cursor;
 
    --  This version of the AI:
-
-   --    10-06-02  AI05-0136-1/07
-
-   --  declares Find_In_Subtree with a Container parameter, but this seems
-   --  incorrect. We need a ruling from the ARG about whether this really was
-   --  intended. ???
+   --   10-06-02  AI05-0136-1/07
+   --  declares Find_In_Subtree this way:
+   --
+   --  function Find_In_Subtree
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
 
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
+
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Ancestor_Find this way:
+   --
+   --  function Ancestor_Find
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
 
    function Contains
      (Container : Tree;
diff --git a/gcc/ada/a-cimutr.adb b/gcc/ada/a-cimutr.adb
index add7605..90fedae 100644
--- a/gcc/ada/a-cimutr.adb
+++ b/gcc/ada/a-cimutr.adb
@@ -164,21 +164,21 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
    -------------------
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
-      R : constant Tree_Node_Access := Root_Node (Container);
-      N : Tree_Node_Access;
+      R, N : Tree_Node_Access;
 
    begin
       if Position = No_Element then
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented-out pending ARG ruling.  ???
+
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
 
       --  AI-0136 says to raise PE if Position equals the root node. This does
       --  not seem correct, as this value is just the limiting condition of the
@@ -188,10 +188,11 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
       --     raise Program_Error with "Position cursor designates root";
       --  end if;
 
+      R := Root_Node (Position.Container.all);
       N := Position.Node;
       while N /= R loop
          if N.Element.all = Item then
-            return Cursor'(Container'Unrestricted_Access, N);
+            return Cursor'(Position.Container, N);
          end if;
 
          N := N.Parent;
@@ -974,9 +975,8 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
    ---------------------
 
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
       Result : Tree_Node_Access;
 
@@ -985,9 +985,11 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented-out pending ruling from ARG.  ???
+
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
 
       if Is_Root (Position) then
          Result := Find_In_Children (Position.Node, Item);
@@ -1000,7 +1002,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Result);
+      return Cursor'(Position.Container, Result);
    end Find_In_Subtree;
 
    function Find_In_Subtree
diff --git a/gcc/ada/a-cimutr.ads b/gcc/ada/a-cimutr.ads
index 7e8e7c8..9f3b5d7 100644
--- a/gcc/ada/a-cimutr.ads
+++ b/gcc/ada/a-cimutr.ads
@@ -113,15 +113,37 @@ package Ada.Containers.Indefinite_Multiway_Trees is
      (Container : Tree;
       Item      : Element_Type) return Cursor;
 
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Find_In_Subtree this way:
+   --
+   --  function Find_In_Subtree
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
+
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
+
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Ancestor_Find this way:
+   --
+   --  function Ancestor_Find
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
 
    function Contains
      (Container : Tree;
diff --git a/gcc/ada/a-comutr.adb b/gcc/ada/a-comutr.adb
index b5132f9..c4ad64e 100644
--- a/gcc/ada/a-comutr.adb
+++ b/gcc/ada/a-comutr.adb
@@ -163,21 +163,21 @@ package body Ada.Containers.Multiway_Trees is
    -------------------
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
-      R : constant Tree_Node_Access := Root_Node (Container);
-      N : Tree_Node_Access;
+      R, N : Tree_Node_Access;
 
    begin
       if Position = No_Element then
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented-out pending official ruling from ARG.  ???
+
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
 
       --  AI-0136 says to raise PE if Position equals the root node. This does
       --  not seem correct, as this value is just the limiting condition of the
@@ -187,10 +187,11 @@ package body Ada.Containers.Multiway_Trees is
       --     raise Program_Error with "Position cursor designates root";
       --  end if;
 
+      R := Root_Node (Position.Container.all);
       N := Position.Node;
       while N /= R loop
          if N.Element = Item then
-            return Cursor'(Container'Unrestricted_Access, N);
+            return Cursor'(Position.Container, N);
          end if;
 
          N := N.Parent;
@@ -950,9 +951,8 @@ package body Ada.Containers.Multiway_Trees is
    ---------------------
 
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
       Result : Tree_Node_Access;
 
@@ -961,9 +961,11 @@ package body Ada.Containers.Multiway_Trees is
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented out pending official ruling by ARG.  ???
+
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
 
       if Is_Root (Position) then
          Result := Find_In_Children (Position.Node, Item);
@@ -976,7 +978,7 @@ package body Ada.Containers.Multiway_Trees is
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Result);
+      return Cursor'(Position.Container, Result);
    end Find_In_Subtree;
 
    function Find_In_Subtree
diff --git a/gcc/ada/a-comutr.ads b/gcc/ada/a-comutr.ads
index 6a9cfde..d2291df 100644
--- a/gcc/ada/a-comutr.ads
+++ b/gcc/ada/a-comutr.ads
@@ -113,15 +113,37 @@ package Ada.Containers.Multiway_Trees is
      (Container : Tree;
       Item      : Element_Type) return Cursor;
 
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Find_In_Subtree this way:
+   --
+   --  function Find_In_Subtree
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
+
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
+
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Ancestor_Find this way:
+   --
+   --  function Ancestor_Find
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
 
    function Contains
      (Container : Tree;
diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb
index 4ecc49d..3a2c940 100644
--- a/gcc/ada/par-endh.adb
+++ b/gcc/ada/par-endh.adb
@@ -799,10 +799,10 @@ package body Endh is
       --  In the following test we protect the call to Comes_From_Source
       --  against lines containing previously reported syntax errors.
 
-      elsif (Etyp = E_Loop
-               or else Etyp = E_Name
-               or else Etyp = E_Suspicious_Is
-               or else Etyp = E_Bad_Is)
+      elsif (Etyp = E_Loop          or else
+             Etyp = E_Name          or else
+             Etyp = E_Suspicious_Is or else
+             Etyp = E_Bad_Is)
          and then Comes_From_Source (L)
       then
          return True;
@@ -818,7 +818,6 @@ package body Endh is
 
    procedure Output_End_Deleted is
    begin
-
       if End_Type = E_Loop then
          Error_Msg_SC ("no LOOP for this `END LOOP`!");
 
@@ -1042,9 +1041,9 @@ package body Endh is
          --  We also reserve an end with a name before the end of file if the
          --  name is the one we expect at the outer level.
 
-         if (Token = Tok_EOF
-               or else Token = Tok_With
-               or else Token = Tok_Separate)
+         if (Token = Tok_EOF  or else
+             Token = Tok_With or else
+             Token = Tok_Separate)
            and then End_Type >= E_Name
            and then (not End_Labl_Present
                       or else Same_Label (End_Labl, Scope.Table (1).Labl))
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index abaf415..1856647 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1539,6 +1539,13 @@ package body Sem_Ch13 is
       --  attribute has the proper type structure. If the name is overloaded,
       --  check that all interpretations are legal.
 
+      procedure Check_Iterator_Functions;
+      --  Check that there is a single function in Default_Iterator attribute
+      --  that  has the  proper type structure.
+
+      function Check_Primitive_Function (Subp : Entity_Id) return Boolean;
+      --  Common legality check for the previoous two.
+
       -----------------------------------
       -- Analyze_Stream_TSS_Definition --
       -----------------------------------
@@ -1681,8 +1688,6 @@ package body Sem_Ch13 is
       ------------------------------
 
       procedure Check_Indexing_Functions is
-         Ctrl : Entity_Id;
-
          procedure Check_One_Function (Subp : Entity_Id);
          --  Check one possible interpretation
 
@@ -1692,34 +1697,10 @@ package body Sem_Ch13 is
 
          procedure Check_One_Function (Subp : Entity_Id) is
          begin
-            if Ekind (Subp) /= E_Function then
-               Error_Msg_N ("indexing requires a function", Subp);
-            end if;
-
-            if No (First_Formal (Subp)) then
-               Error_Msg_N
-                 ("function for indexing must have parameters", Subp);
-            else
-               Ctrl := Etype (First_Formal (Subp));
-            end if;
-
-            if Ctrl = Ent
-              or else Ctrl = Class_Wide_Type (Ent)
-              or else
-                (Ekind (Ctrl) = E_Anonymous_Access_Type
-                  and then
-                    (Designated_Type (Ctrl) = Ent
-                      or else Designated_Type (Ctrl) = Class_Wide_Type (Ent)))
-            then
-               null;
-
-            else
-               Error_Msg_N ("indexing function must apply to type&", Subp);
-            end if;
-
-            if No (Next_Formal (First_Formal (Subp))) then
-               Error_Msg_N
-                 ("function for indexing must have two parameters", Subp);
+            if not Check_Primitive_Function (Subp) then
+               Error_Msg_NE
+                 ("aspect Indexing requires a function that applies to type&",
+                   Subp, Ent);
             end if;
 
             if not Has_Implicit_Dereference (Etype (Subp)) then
@@ -1731,6 +1712,10 @@ package body Sem_Ch13 is
       --  Start of processing for Check_Indexing_Functions
 
       begin
+         if In_Instance then
+            return;
+         end if;
+
          Analyze (Expr);
 
          if not Is_Overloaded (Expr) then
@@ -1759,6 +1744,138 @@ package body Sem_Ch13 is
          end if;
       end Check_Indexing_Functions;
 
+      ------------------------------
+      -- Check_Iterator_Functions --
+      ------------------------------
+
+      procedure Check_Iterator_Functions is
+         Default : Entity_Id;
+
+         function Valid_Default_Iterator (Subp : Entity_Id) return Boolean;
+         --  Check one possible interpretation.
+
+         ----------------------------
+         -- Valid_Default_Iterator --
+         ----------------------------
+
+         function Valid_Default_Iterator (Subp : Entity_Id) return Boolean is
+            Formal : Entity_Id;
+
+         begin
+            if not Check_Primitive_Function (Subp) then
+               return False;
+            else
+               Formal := First_Formal (Subp);
+            end if;
+
+            Formal := Next_Formal (Formal);
+
+            --  I don't see why the if is required here, we will return
+            --  True anyway if Present (Formal) is false on first loop ???
+
+            if No (Formal) then
+               return True;
+
+            else
+               while Present (Formal) loop
+                  if No (Expression (Parent (Formal))) then
+                     return False;
+                  end if;
+
+                  Next_Formal (Formal);
+               end loop;
+            end if;
+
+            return True;
+         end Valid_Default_Iterator;
+
+      --  Start of processing for Check_Iterator_Functions
+
+      begin
+         Analyze (Expr);
+
+         if not Is_Entity_Name (Expr) then
+            Error_Msg_N ("aspect Iterator must be a function name", Expr);
+         end if;
+
+         if not Is_Overloaded (Expr) then
+            if not Check_Primitive_Function (Entity (Expr)) then
+               Error_Msg_NE
+                 ("aspect Indexing requires a function that applies to type&",
+                   Entity (Expr), Ent);
+            end if;
+
+            if not Valid_Default_Iterator (Entity (Expr)) then
+               Error_Msg_N ("improper function for default iterator", Expr);
+            end if;
+
+         else
+            Default := Empty;
+            declare
+               I : Interp_Index;
+               It : Interp;
+
+            begin
+               Get_First_Interp (Expr, I, It);
+               while Present (It.Nam) loop
+                  if not Check_Primitive_Function (It.Nam)
+                    or else Valid_Default_Iterator (It.Nam)
+                  then
+                     Remove_Interp (I);
+
+                  elsif Present (Default) then
+                     Error_Msg_N ("default iterator must be unique", Expr);
+
+                  else
+                     Default := It.Nam;
+                  end if;
+
+                  Get_Next_Interp (I, It);
+               end loop;
+            end;
+
+            if Present (Default) then
+               Set_Entity (Expr, Default);
+               Set_Is_Overloaded (Expr, False);
+            end if;
+         end if;
+      end Check_Iterator_Functions;
+
+      -------------------------------
+      -- Check_Primitive_Function  --
+      -------------------------------
+
+      function Check_Primitive_Function (Subp : Entity_Id) return Boolean is
+         Ctrl : Entity_Id;
+
+      begin
+         if Ekind (Subp) /= E_Function then
+            return False;
+         end if;
+
+         if No (First_Formal (Subp)) then
+            return False;
+         else
+            Ctrl := Etype (First_Formal (Subp));
+         end if;
+
+         if Ctrl = Ent
+           or else Ctrl = Class_Wide_Type (Ent)
+           or else
+             (Ekind (Ctrl) = E_Anonymous_Access_Type
+               and then
+                 (Designated_Type (Ctrl) = Ent
+                   or else Designated_Type (Ctrl) = Class_Wide_Type (Ent)))
+         then
+            null;
+
+         else
+            return False;
+         end if;
+
+         return True;
+      end Check_Primitive_Function;
+
       ----------------------
       -- Duplicate_Clause --
       ----------------------
@@ -2385,6 +2502,39 @@ package body Sem_Ch13 is
          when Attribute_Constant_Indexing =>
             Check_Indexing_Functions;
 
+         ----------------------
+         -- Default_Iterator --
+         ----------------------
+
+         when Attribute_Default_Iterator =>  Default_Iterator : declare
+            Func : Entity_Id;
+
+         begin
+            if not Is_Tagged_Type (U_Ent) then
+               Error_Msg_N
+                 ("aspect Default_Iterator applies to  tagged type", Nam);
+            end if;
+
+            Check_Iterator_Functions;
+
+            Analyze (Expr);
+
+            if not Is_Entity_Name (Expr)
+              or else Ekind (Entity (Expr)) /= E_Function
+            then
+               Error_Msg_N ("aspect Iterator must be a function", Expr);
+            else
+               Func := Entity (Expr);
+            end if;
+
+            if No (First_Formal (Func))
+              or else Etype (First_Formal (Func)) /= U_Ent
+            then
+               Error_Msg_NE
+                 ("Default Iterator must be a primitive of&", Func, U_Ent);
+            end if;
+         end Default_Iterator;
+
          ------------------
          -- External_Tag --
          ------------------
@@ -2431,9 +2581,10 @@ package body Sem_Ch13 is
 
          when Attribute_Implicit_Dereference =>
 
-            --  Legality checks already performed above
+            --  Legality checks already performed at the point of
+            --  the type declaration, aspect is not delayed.
 
-            null;   --  TBD???
+            null;
 
          -----------
          -- Input --
@@ -2443,6 +2594,19 @@ package body Sem_Ch13 is
             Analyze_Stream_TSS_Definition (TSS_Stream_Input);
             Set_Has_Specified_Stream_Input (Ent);
 
+         ----------------------
+         -- Iterator_Element --
+         ----------------------
+
+         when Attribute_Iterator_Element =>
+            Analyze (Expr);
+
+            if not Is_Entity_Name (Expr)
+              or else not Is_Type (Entity (Expr))
+            then
+               Error_Msg_N ("aspect Iterator_Element must be a type", Expr);
+            end if;
+
          -------------------
          -- Machine_Radix --
          -------------------
@@ -3546,6 +3710,7 @@ package body Sem_Ch13 is
                if Nkind (Ritem) = N_Aspect_Specification
                  and then Entity (Ritem) = E
                  and then Is_Delayed_Aspect (Ritem)
+                 and then Scope (E) = Current_Scope
                then
                   Check_Aspect_At_Freeze_Point (Ritem);
                end if;
@@ -5482,7 +5647,7 @@ package body Sem_Ch13 is
       Ident : constant Node_Id   := Identifier (ASN);
 
       Freeze_Expr : constant Node_Id := Expression (ASN);
-      --  Preanalyzed expression from call to Check_Aspect_At_Freeze_Point
+      --  Expression from call to Check_Aspect_At_Freeze_Point
 
       End_Decl_Expr : constant Node_Id := Entity (Ident);
       --  Expression to be analyzed at end of declarations
@@ -5512,11 +5677,20 @@ package body Sem_Ch13 is
          Err := Entity (End_Decl_Expr) /= Entity (Freeze_Expr);
 
       elsif A_Id = Aspect_Variable_Indexing or else
-            A_Id = Aspect_Constant_Indexing
+            A_Id = Aspect_Constant_Indexing or else
+            A_Id = Aspect_Default_Iterator  or else
+            A_Id = Aspect_Iterator_Element
       then
          Analyze (End_Decl_Expr);
          Analyze (Aspect_Rep_Item (ASN));
-         Err := Entity (End_Decl_Expr) /= Entity (Freeze_Expr);
+
+         --  If the end of declarations comes before any other freeze
+         --  point, the Freeze_Expr is not analyzed: no check needed.
+
+         Err :=
+           Analyzed (Freeze_Expr)
+             and then not In_Instance
+             and then Entity (End_Decl_Expr) /= Entity (Freeze_Expr);
 
       --  All other cases