aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorHristian Kirtchev <kirtchev@adacore.com>2016-04-20 09:00:58 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2016-04-20 11:00:58 +0200
commitae3d8837bd4e64b3e0ffc43b2b997248ed5c66e2 (patch)
tree9bda9fccef16478079d523d1a7ba286a160aed03 /gcc
parent776fbb7478011611c58ba664a4c8ef3a0df8f75f (diff)
downloadgcc-ae3d8837bd4e64b3e0ffc43b2b997248ed5c66e2.zip
gcc-ae3d8837bd4e64b3e0ffc43b2b997248ed5c66e2.tar.gz
gcc-ae3d8837bd4e64b3e0ffc43b2b997248ed5c66e2.tar.bz2
sem_ch13.adb (Build_Invariant_Procedure): Reimplement the invariant procedure spec and body insertion.
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com> * sem_ch13.adb (Build_Invariant_Procedure): Reimplement the invariant procedure spec and body insertion. From-SVN: r235239
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog5
-rw-r--r--gcc/ada/sem_ch13.adb50
2 files changed, 27 insertions, 28 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 64294de..93e1eeb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,10 @@
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com>
+ * sem_ch13.adb (Build_Invariant_Procedure):
+ Reimplement the invariant procedure spec and body insertion.
+
+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
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 2302e66..5fc8304 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -8335,46 +8335,40 @@ package body Sem_Ch13 is
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stmts));
- -- Insert procedure declaration and spec at the appropriate points.
- -- If declaration is already analyzed, it was processed by the
- -- generated pragma.
+ -- The processing of an invariant pragma immediately generates the
+ -- invariant procedure spec, inserts it into the tree and analyzes
+ -- it. If the spec has not been analyzed, then the invariant pragma
+ -- is being inherited and requires manual insertion and analysis.
- if Present (Priv_Decls) then
-
- -- The spec goes at the end of visible declarations, but they have
- -- already been analyzed, so we need to explicitly do the analyze.
-
- if not Analyzed (PDecl) then
- Append_To (Vis_Decls, PDecl);
- Analyze (PDecl);
- end if;
+ if not Analyzed (PDecl) then
+ Append_To (Vis_Decls, PDecl);
+ Analyze (PDecl);
+ end if;
- -- The body goes at the end of the private declarations, which we
- -- have not analyzed yet, so we do not need to perform an explicit
- -- analyze call. We skip this if there are no private declarations
- -- (this is an error that will be caught elsewhere);
+ -- The invariant procedure body is inserted at the end of the private
+ -- declarations.
+ if Present (Priv_Decls) then
Append_To (Priv_Decls, PBody);
- -- If the invariant appears on the full view of a type, the
- -- analysis of the private part is complete, and we must
- -- analyze the new body explicitly.
+ -- If the invariant appears on the full view of a private type,
+ -- then the analysis of the private part is already completed.
+ -- Manually analyze the new body in this case, otherwise wait
+ -- for the analysis of the private declarations to process the
+ -- body.
if In_Private_Part (Current_Scope) then
Analyze (PBody);
end if;
- -- If there are no private declarations this may be an error that
- -- will be diagnosed elsewhere. However, if this is a non-private
- -- type that inherits invariants, it needs no completion and there
- -- may be no private part. In this case insert invariant procedure
- -- at end of current declarative list, and analyze at once, given
- -- that the type is about to be frozen.
+ -- Otherwise there are no private declarations. This is either an
+ -- error or the related type is a private extension in which case
+ -- it does not need a completion in a private part. Insert the body
+ -- and the end of the visible declarations and analyze immediately
+ -- because the related type is about to be frozen.
- elsif not Is_Private_Type (Typ) then
- Append_To (Vis_Decls, PDecl);
+ else
Append_To (Vis_Decls, PBody);
- Analyze (PDecl);
Analyze (PBody);
end if;
end if;