aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2016-04-20 10:59:02 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2016-04-20 10:59:02 +0200
commit776fbb7478011611c58ba664a4c8ef3a0df8f75f (patch)
treea315c178373ebadba5cbdbb438ee08abaa5cf2c8
parent60d393e89c924e71208f72a7007e16dc8720bcc9 (diff)
downloadgcc-776fbb7478011611c58ba664a4c8ef3a0df8f75f.zip
gcc-776fbb7478011611c58ba664a4c8ef3a0df8f75f.tar.gz
gcc-776fbb7478011611c58ba664a4c8ef3a0df8f75f.tar.bz2
[multiple changes]
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com> * sem_ch13.adb (Add_Invariant): Do not replace the saved expression of an invariatn aspect when inheriting a class-wide type invariant as this clobbers the existing expression. Do not use New_Copy_List as it is unnecessary and leaves the parent pointers referencing the wrong part of the tree. Do not replace the type references for ASIS when inheriting a class-wide type invariant as this clobbers the existing replacement. 2016-04-20 Ed Schonberg <schonberg@adacore.com> * sem_util.adb (Build_Explicit_Dereference): If the designated expression is an entity name, generate reference to the entity because it will not be resolved again. From-SVN: r235238
-rw-r--r--gcc/ada/ChangeLog17
-rw-r--r--gcc/ada/sem_ch13.adb72
-rw-r--r--gcc/ada/sem_util.adb5
3 files changed, 62 insertions, 32 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 20f7ed2..64294de 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+2016-04-20 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch13.adb (Add_Invariant): Do not replace
+ the saved expression of an invariatn aspect when inheriting
+ a class-wide type invariant as this clobbers the existing
+ expression. Do not use New_Copy_List as it is unnecessary
+ and leaves the parent pointers referencing the wrong part of
+ the tree. Do not replace the type references for ASIS when
+ inheriting a class-wide type invariant as this clobbers the
+ existing replacement.
+
+2016-04-20 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_util.adb (Build_Explicit_Dereference): If the designated
+ expression is an entity name, generate reference to the entity
+ because it will not be resolved again.
+
2016-04-19 Arnaud Charlet <charlet@adacore.com>
* doc/gnat_rm/standard_and_implementation_defined_restrictions.rst,
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index b436b43..2302e66 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -8048,9 +8048,11 @@ package body Sem_Ch13 is
-- If the invariant pragma comes from an aspect, replace the saved
-- expression because we need the subtype references replaced for
-- the calls to Preanalyze_Spec_Expression in Check_Aspect_At_xxx
- -- routines.
+ -- routines. This is not done for interited class-wide invariants
+ -- because the original pragma of the parent type must remain
+ -- unchanged.
- if Present (Asp) then
+ if not Inherit and then Present (Asp) then
Set_Entity (Identifier (Asp), New_Copy_Tree (Expr));
end if;
@@ -8066,40 +8068,46 @@ package body Sem_Ch13 is
Set_Parent (Expr, Parent (Arg2));
Preanalyze_Assert_Expression (Expr, Any_Boolean);
- -- A class-wide invariant may be inherited in a separate unit,
- -- where the corresponding expression cannot be resolved by
- -- visibility, because it refers to a local function. Propagate
- -- semantic information to the original representation item, to
- -- be used when an invariant procedure for a derived type is
- -- constructed.
+ -- Both modifications performed below are not done for inherited
+ -- class-wide invariants because the origial aspect/pragma of the
+ -- parent type must remain unchanged.
- -- ??? Unclear how to handle class-wide invariants that are not
- -- function calls.
+ if not Inherit then
- if not Inherit
- and then Class_Present (Prag)
- and then Nkind (Expr) = N_Function_Call
- and then Nkind (Arg2) = N_Indexed_Component
- then
- Rewrite (Arg2,
- Make_Function_Call (Ploc,
- Name =>
- New_Occurrence_Of (Entity (Name (Expr)), Ploc),
- Parameter_Associations =>
- New_Copy_List (Expressions (Arg2))));
- end if;
+ -- A class-wide invariant may be inherited in a separate unit,
+ -- where the corresponding expression cannot be resolved by
+ -- visibility, because it refers to a local function. Propagate
+ -- semantic information to the original representation item, to
+ -- be used when an invariant procedure for a derived type is
+ -- constructed.
- -- In ASIS mode, even if assertions are not enabled, we must
- -- analyze the original expression in the aspect specification
- -- because it is part of the original tree.
+ -- ??? Unclear how to handle class-wide invariants that are not
+ -- function calls.
- if ASIS_Mode and then Present (Asp) then
- declare
- Orig_Expr : constant Node_Id := Expression (Asp);
- begin
- Replace_Type_References (Orig_Expr, T);
- Preanalyze_Assert_Expression (Orig_Expr, Any_Boolean);
- end;
+ if Class_Present (Prag)
+ and then Nkind (Expr) = N_Function_Call
+ and then Nkind (Arg2) = N_Indexed_Component
+ then
+ Rewrite (Arg2,
+ Make_Function_Call (Ploc,
+ Name =>
+ New_Occurrence_Of (Entity (Name (Expr)), Ploc),
+ Parameter_Associations => Expressions (Arg2)));
+ end if;
+
+ -- In ASIS mode, even if assertions are not enabled, we must
+ -- analyze the original expression in the aspect specification
+ -- because it is part of the original tree.
+
+ if ASIS_Mode and then Present (Asp) then
+ declare
+ Asp_Expr : constant Node_Id := Expression (Asp);
+
+ begin
+ Replace_Type_References (Asp_Expr, T);
+ Preanalyze_Assert_Expression (Asp_Expr, Any_Boolean);
+ end;
+ end if;
end if;
-- An ignored invariant must not generate a runtime check. Add a
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index ba4f032..d03eca8 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1759,6 +1759,11 @@ package body Sem_Util is
if Is_Entity_Name (Expr) then
Set_Etype (Expr, Etype (Entity (Expr)));
+ -- The designated entity will not be examined again when resolving
+ -- the dereference, so generate a reference to it now.
+
+ Generate_Reference (Entity (Expr), Expr);
+
elsif Nkind (Expr) = N_Function_Call then
-- If the name of the indexing function is overloaded, locate the one