Commit 2fe258bf by Arnaud Charlet

[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
parent b4dfdc11
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> 2014-07-31 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Build_Invariant_Procedure): If body of procedure * sem_ch13.adb (Build_Invariant_Procedure): If body of procedure
......
...@@ -3763,7 +3763,15 @@ package body Exp_Ch3 is ...@@ -3763,7 +3763,15 @@ package body Exp_Ch3 is
if Has_Invariants (Etype (Id)) if Has_Invariants (Etype (Id))
and then In_Open_Scopes (Scope (R_Type)) and then In_Open_Scopes (Scope (R_Type))
then 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)) elsif Is_Access_Type (Etype (Id))
and then not Is_Access_Constant (Etype (Id)) and then not Is_Access_Constant (Etype (Id))
......
...@@ -4537,6 +4537,24 @@ package body Freeze is ...@@ -4537,6 +4537,24 @@ package body Freeze is
return No_List; return No_List;
end if; 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 -- Deal with special cases of freezing for subtype
if E /= Base_Type (E) then if E /= Base_Type (E) then
......
...@@ -7489,7 +7489,8 @@ package body Sem_Ch13 is ...@@ -7489,7 +7489,8 @@ package body Sem_Ch13 is
-- the type is already frozen, which is the case when the invariant -- the type is already frozen, which is the case when the invariant
-- appears in a private part, and the freezing takes place before the -- appears in a private part, and the freezing takes place before the
-- final pass over full declarations. -- 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 if Present (SId) then
PDecl := Unit_Declaration_Node (SId); PDecl := Unit_Declaration_Node (SId);
......
...@@ -1391,19 +1391,14 @@ package body Sem_Ch6 is ...@@ -1391,19 +1391,14 @@ package body Sem_Ch6 is
end if; end if;
else 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; Is_Completion := True;
Rewrite (N, Null_Body);
if Expander_Active then Analyze (N);
Rewrite (N, Null_Body);
Analyze (N);
else
Designator := Analyze_Subprogram_Specification (Spec);
Set_Has_Completion (Designator);
Set_Has_Completion (Prev);
end if;
end if; end if;
end Analyze_Null_Procedure; end Analyze_Null_Procedure;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment