From: Ed Schonberg <schonberg@adacore.com>
Date: Thu, 21 May 2015 10:47:34 +0000 (+0000)
Subject: sem_ch13.adb (Check_Iterator_Functions): Emit error on Iterator aspect as well when... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=4f2cae4a92d1135ededcecdffd84e1c4c394b083;p=gcc.git

sem_ch13.adb (Check_Iterator_Functions): Emit error on Iterator aspect as well when indexing function is illegal.

2015-05-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Check_Iterator_Functions): Emit error on Iterator
	aspect as well when indexing function is illegal.
	(Valid_Default_Iterator): Handle properly somme illegal cases
	to prevent compilation abandoned messages.
	(Check_Primitive_Function): Verify that type and indexing function
	are in the same scope.
	* freeze.adb (Freeze_Record): Extend patch on the presence of
	indexing aspects to aspect Default_Iterator.

From-SVN: r223475
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 004901ef170..230a62b905b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2015-05-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Check_Iterator_Functions): Emit error on Iterator
+	aspect as well when indexing function is illegal.
+	(Valid_Default_Iterator): Handle properly somme illegal cases
+	to prevent compilation abandoned messages.
+	(Check_Primitive_Function): Verify that type and indexing function
+	are in the same scope.
+	* freeze.adb (Freeze_Record): Extend patch on the presence of
+	indexing aspects to aspect Default_Iterator.
+
 2015-05-19  David Malcolm  <dmalcolm@redhat.com>
 
 	* gcc-interface/trans.c (Sloc_to_locus1): Strenghthen local "map"
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 2377c39c3d2..14c2aa3336f 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3048,7 +3048,9 @@ package body Freeze is
                Set_Etype (Formal, F_Type);
             end if;
 
-            Freeze_And_Append (F_Type, N, Result);
+            if not From_Limited_With (F_Type) then
+               Freeze_And_Append (F_Type, N, Result);
+            end if;
 
             if Is_Private_Type (F_Type)
               and then Is_Private_Type (Base_Type (F_Type))
@@ -4288,21 +4290,32 @@ package body Freeze is
             end if;
          end if;
 
-         --  Make sure that if we have aspect Iterator_Element, then we have
+         --  Make sure that if we have terator aspect, then we have
          --  either Constant_Indexing or Variable_Indexing.
 
-         if Has_Aspect (Rec, Aspect_Iterator_Element) then
-            if Has_Aspect (Rec, Aspect_Constant_Indexing)
+         declare
+            Iterator_Aspect : Node_Id;
+
+         begin
+            Iterator_Aspect := Find_Aspect (Rec, Aspect_Iterator_Element);
+
+            if No (Iterator_Aspect) then
+               Iterator_Aspect := Find_Aspect (Rec, Aspect_Default_Iterator);
+            end if;
+
+            if Present (Iterator_Aspect) then
+               if Has_Aspect (Rec, Aspect_Constant_Indexing)
                  or else
-               Has_Aspect (Rec, Aspect_Variable_Indexing)
-            then
-               null;
-            else
-               Error_Msg_N
-                 ("Iterator_Element requires indexing aspect",
-                  Find_Aspect (Rec, Aspect_Iterator_Element));
+                  Has_Aspect (Rec, Aspect_Variable_Indexing)
+               then
+                  null;
+               else
+                  Error_Msg_N
+                    ("Iterator_Element requires indexing aspect",
+                       Iterator_Aspect);
+               end if;
             end if;
-         end if;
+         end;
 
          --  All done if not a full record definition
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 30437ba5eea..1de87d9fc57 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -4124,8 +4124,10 @@ package body Sem_Ch13 is
                    Entity (Expr), Ent);
             end if;
 
+            --  Flag the default_iterator as well as the denoted function.
+
             if not Valid_Default_Iterator (Entity (Expr)) then
-               Error_Msg_N ("improper function for default iterator", Expr);
+               Error_Msg_N ("improper function for default iterator!", Expr);
             end if;
 
          else
@@ -4178,6 +4180,12 @@ package body Sem_Ch13 is
             Ctrl := Etype (First_Formal (Subp));
          end if;
 
+         --  To be a primitive operation subprogram has to be in same scope.
+
+         if Scope (Ctrl) /= Scope (Subp) then
+            return False;
+         end if;
+
          --  Type of formal may be the class-wide type, an access to such,
          --  or an incomplete view.
 
@@ -4972,9 +4980,12 @@ package body Sem_Ch13 is
             Typ  : Entity_Id;
 
          begin
+            --  If target type is untagged, further checks are irrelevant
+
             if not Is_Tagged_Type (U_Ent) then
                Error_Msg_N
-                 ("aspect Default_Iterator applies to  tagged type", Nam);
+                 ("aspect Default_Iterator applies to tagged type", Nam);
+               return;
             end if;
 
             Check_Iterator_Functions;
@@ -4985,15 +4996,17 @@ package body Sem_Ch13 is
               or else Ekind (Entity (Expr)) /= E_Function
             then
                Error_Msg_N ("aspect Iterator must be a function", Expr);
+               return;
             else
                Func := Entity (Expr);
             end if;
 
             --  The type of the first parameter must be T, T'class, or a
-            --  corresponding access type (5.5.1 (8/3)
+            --  corresponding access type (5.5.1 (8/3). If function is
+            --  parameterless label type accordingly.
 
             if No (First_Formal (Func)) then
-               Typ := Empty;
+               Typ := Any_Type;
             else
                Typ := Etype (First_Formal (Func));
             end if;