From: Ed Schonberg <schonberg@adacore.com>
Date: Mon, 26 Oct 2015 10:24:05 +0000 (+0000)
Subject: sem_ch12.adb (Analyze_Formal_Package_Declaration): Code clean up.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8c14315a0de2a70121941f646942a476767fad4e;p=gcc.git

sem_ch12.adb (Analyze_Formal_Package_Declaration): Code clean up.


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

	* sem_ch12.adb (Analyze_Formal_Package_Declaration): Code clean up.
	* sem_ch13.adb (Check_Inherited_Indexing): New inner procedure
	of Check_Indexing_Functions, to verify that a derived type with an
	Indexing aspect is not inheriting such an aspect from an ancestor.
	(Check_Indexing_Functions): Call Check_Inherited_Indexing within
	an instance.

From-SVN: r229316
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 936a924f316..d0f3e5f8dac 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2015-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Analyze_Formal_Package_Declaration): Code clean up.
+	* sem_ch13.adb (Check_Inherited_Indexing): New inner procedure
+	of Check_Indexing_Functions, to verify that a derived type with an
+	Indexing aspect is not inheriting such an aspect from an ancestor.
+	(Check_Indexing_Functions): Call Check_Inherited_Indexing within
+	an instance.
+
 2015-10-26  Gary Dismukes  <dismukes@adacore.com>
 
 	* a-reatim.adb, contracts.adb, contracts.ads: Minor reformatting and
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 6891c64b225..7d52d2e44ae 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -2587,7 +2587,6 @@ package body Sem_Ch12 is
         or else Nkind (First (Generic_Associations (N))) = N_Others_Choice
       then
          Associations := False;
-         Set_Box_Present (N);
       end if;
 
       --  If there are no generic associations, the generic parameters appear
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 9f7794f61c7..fea90d11d64 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -3971,6 +3971,10 @@ package body Sem_Ch13 is
       procedure Check_Indexing_Functions is
          Indexing_Found : Boolean := False;
 
+         procedure Check_Inherited_Indexing;
+         --  For a derived type, check that no indexing aspect is specified
+         --  for the type if it is also inherited
+
          procedure Check_One_Function (Subp : Entity_Id);
          --  Check one possible interpretation. Sets Indexing_Found True if a
          --  legal indexing function is found.
@@ -3979,6 +3983,46 @@ package body Sem_Ch13 is
          --  Diagnose illegal indexing function if not overloaded. In the
          --  overloaded case indicate that no legal interpretation  exists.
 
+         ------------------------------
+         -- Check_Inherited_Indexing --
+         ------------------------------
+
+         procedure Check_Inherited_Indexing is
+            Inherited : Node_Id;
+
+         begin
+            if Attr = Name_Constant_Indexing then
+               Inherited :=
+                 Find_Aspect (Etype (Ent), Aspect_Constant_Indexing);
+            else pragma Assert (Attr = Name_Variable_Indexing);
+               Inherited :=
+                  Find_Aspect (Etype (Ent), Aspect_Variable_Indexing);
+            end if;
+
+            if Present (Inherited) then
+               if Debug_Flag_Dot_XX then
+                  null;
+
+               --  OK if current attribute_definition_clause is expansion
+               --  of inherited aspect.
+
+               elsif Aspect_Rep_Item (Inherited) = N then
+                  null;
+
+               --  Indicate the operation that must be overridden, rather
+               --  than redefining the indexing aspect
+
+               else
+                  Illegal_Indexing
+                    ("indexing function already inherited "
+                     & "from parent type");
+                  Error_Msg_NE
+                    ("!override & instead",
+                     N, Entity (Expression (Inherited)));
+               end if;
+            end if;
+         end Check_Inherited_Indexing;
+
          ------------------------
          -- Check_One_Function --
          ------------------------
@@ -4013,40 +4057,8 @@ package body Sem_Ch13 is
                  ("indexing function must have at least two parameters");
                return;
 
-            --  For a derived type, check that no indexing aspect is specified
-            --  for the type if it is also inherited
-
             elsif Is_Derived_Type (Ent) then
-               declare
-                  Inherited : Node_Id;
-
-               begin
-                  if Attr = Name_Constant_Indexing then
-                     Inherited :=
-                       Find_Aspect (Etype (Ent), Aspect_Constant_Indexing);
-                  else pragma Assert (Attr = Name_Variable_Indexing);
-                     Inherited :=
-                        Find_Aspect (Etype (Ent), Aspect_Variable_Indexing);
-                  end if;
-
-                  if Present (Inherited) then
-                     if Debug_Flag_Dot_XX then
-                        null;
-
-                     --  Indicate the operation that must be overridden, rather
-                     --  than redefining the indexing aspect
-
-                     else
-                        Illegal_Indexing
-                          ("indexing function already inherited "
-                           & "from parent type");
-                        Error_Msg_NE
-                          ("!override & instead",
-                           N, Entity (Expression (Inherited)));
-                        return;
-                     end if;
-                  end if;
-               end;
+               Check_Inherited_Indexing;
             end if;
 
             if not Check_Primitive_Function (Subp) then
@@ -4165,7 +4177,7 @@ package body Sem_Ch13 is
 
       begin
          if In_Instance then
-            return;
+            Check_Inherited_Indexing;
          end if;
 
          Analyze (Expr);