diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 18 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 17 |
5 files changed, 53 insertions, 13 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0d3638d..b88d174 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2014-07-31 Robert Dewar <dewar@adacore.com> + + * sem_ch13.adb: Minor reformatting. + +2014-07-31 Ed Schonberg <schonberg@adacore.com> + + * exp_ch3.adb (Build_Invariant_Checks): If the enclosing record + is an unchecked_union, warn that invariants will not be checked + on components that have them. + +2014-07-31 Robert Dewar <dewar@adacore.com> + + * freeze.adb (Freeze_Entity): Check for error of + Type_Invariant'Class applied to a untagged type. + * sem_ch6.adb (Analyze_Null_Procedure): Unconditionally rewrite + as null body, so that we perform error checks even if expansion + is off. + 2014-07-31 Ed Schonberg <schonberg@adacore.com> * sem_ch13.adb (Build_Invariant_Procedure): If body of procedure diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 520f932..53985f1 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -3763,7 +3763,15 @@ package body Exp_Ch3 is if Has_Invariants (Etype (Id)) and then In_Open_Scopes (Scope (R_Type)) then - Append_To (Stmts, Build_Component_Invariant_Call (Id)); + if Has_Unchecked_Union (R_Type) then + Error_Msg_NE + ("invariants cannot be checked on components of " + & "unchecked_union type&?", Decl, R_Type); + return Empty_List; + + else + Append_To (Stmts, Build_Component_Invariant_Call (Id)); + end if; elsif Is_Access_Type (Etype (Id)) and then not Is_Access_Constant (Etype (Id)) diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 5864dfc..aad4761 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4537,6 +4537,24 @@ package body Freeze is return No_List; end if; + -- Check for error of Type_Invariant'Class applied to a untagged type + -- (check delayed to freeze time when full type is available). + + declare + Prag : constant Node_Id := Get_Pragma (E, Pragma_Invariant); + begin + if Present (Prag) + and then Class_Present (Prag) + and then not Is_Tagged_Type (E) + then + Error_Msg_NE + ("Type_Invariant''Class cannot be specified for &", + Prag, E); + Error_Msg_N + ("\can only be specified for a tagged type", Prag); + end if; + end; + -- Deal with special cases of freezing for subtype if E /= Base_Type (E) then diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 7454eae..bbbf712 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -7489,7 +7489,8 @@ package body Sem_Ch13 is -- the type is already frozen, which is the case when the invariant -- appears in a private part, and the freezing takes place before the -- final pass over full declarations. - -- See exp_ch3.Insert_Component_Invariant_Checks for details. + + -- See Exp_Ch3.Insert_Component_Invariant_Checks for details. if Present (SId) then PDecl := Unit_Declaration_Node (SId); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 77c3294..cce2a48 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1391,19 +1391,14 @@ package body Sem_Ch6 is end if; else - -- The null procedure is a completion + -- The null procedure is a completion. We unconditionally rewrite + -- this as a null body (even if expansion is not active), because + -- there are various error checks that are applied on this body + -- when it is analyzed (e.g. correct aspect placement). Is_Completion := True; - - if Expander_Active then - Rewrite (N, Null_Body); - Analyze (N); - - else - Designator := Analyze_Subprogram_Specification (Spec); - Set_Has_Completion (Designator); - Set_Has_Completion (Prev); - end if; + Rewrite (N, Null_Body); + Analyze (N); end if; end Analyze_Null_Procedure; |