aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2015-10-26 10:24:05 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2015-10-26 11:24:05 +0100
commit8c14315a0de2a70121941f646942a476767fad4e (patch)
tree3a2e33ee6564818115b96ca0643b1f32272c7793
parent013a83cc0252d9cc8cce994000d7a44d8e40555b (diff)
downloadgcc-8c14315a0de2a70121941f646942a476767fad4e.zip
gcc-8c14315a0de2a70121941f646942a476767fad4e.tar.gz
gcc-8c14315a0de2a70121941f646942a476767fad4e.tar.bz2
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
-rw-r--r--gcc/ada/ChangeLog9
-rw-r--r--gcc/ada/sem_ch12.adb1
-rw-r--r--gcc/ada/sem_ch13.adb80
3 files changed, 55 insertions, 35 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 936a924..d0f3e5f 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 6891c64..7d52d2e 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 9f7794f..fea90d1 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);