diff options
author | Hristian Kirtchev <kirtchev@adacore.com> | 2016-04-20 09:00:58 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2016-04-20 11:00:58 +0200 |
commit | ae3d8837bd4e64b3e0ffc43b2b997248ed5c66e2 (patch) | |
tree | 9bda9fccef16478079d523d1a7ba286a160aed03 /gcc | |
parent | 776fbb7478011611c58ba664a4c8ef3a0df8f75f (diff) | |
download | gcc-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/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 50 |
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; |