[multiple changes]
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. From-SVN: r213324
This commit is contained in:
parent
b4dfdc11a5
commit
2fe258bf93
5 changed files with 53 additions and 13 deletions
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue