sem_ch13.adb (Build_Invariant_Procedure): If body of procedure is already present, nothing to do.

2014-07-31  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Build_Invariant_Procedure): If body of procedure
	is already present, nothing to do.
	* exp_ch3.adb (Build_Component_Invariant_Call): For an access
	component, check whether the access type has an invariant before
	checking the designated type.
	(Build_Record_Invariant_Proc): Change suffix of generated
	name to prevent ambiguity when record type has invariants
	in addition to those of components, and two subprograms are
	constructed. Consistent with handling of array types.
	(Insert_Component_Invariant_Checks): Build invariant procedure
	body when one has not been created yet, in the case of composite
	types that are completions and whose full declarations carry
	invariants.

From-SVN: r213322
This commit is contained in:
Ed Schonberg 2014-07-31 09:33:10 +00:00 committed by Arnaud Charlet
parent a793528482
commit 3e50df4de7
3 changed files with 70 additions and 6 deletions

View File

@ -1,3 +1,19 @@
2014-07-31 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Build_Invariant_Procedure): If body of procedure
is already present, nothing to do.
* exp_ch3.adb (Build_Component_Invariant_Call): For an access
component, check whether the access type has an invariant before
checking the designated type.
(Build_Record_Invariant_Proc): Change suffix of generated
name to prevent ambiguity when record type has invariants
in addition to those of components, and two subprograms are
constructed. Consistent with handling of array types.
(Insert_Component_Invariant_Checks): Build invariant procedure
body when one has not been created yet, in the case of composite
types that are completions and whose full declarations carry
invariants.
2014-07-30 Thomas Quinot <quinot@adacore.com>
* gnat_rm.texi: Minor doc fixes.

View File

@ -56,6 +56,7 @@ with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
with Sem_Disp; use Sem_Disp;
with Sem_Eval; use Sem_Eval;
with Sem_Mech; use Sem_Mech;
@ -3704,8 +3705,21 @@ package body Exp_Ch3 is
Selector_Name => New_Occurrence_Of (Comp, Loc));
if Is_Access_Type (Typ) then
Sel_Comp := Make_Explicit_Dereference (Loc, Sel_Comp);
Typ := Designated_Type (Typ);
-- If the access component designates a type with an invariant,
-- the check applies to the designated object. The access type
-- itself may have an invariant, in which case it applies to the
-- access value directly.
-- Note: we are assuming that invariants will not occur on both
-- the access type and the type that it designates. This is not
-- really justified but it is hard to imagine that this case will
-- ever cause trouble ???
if not (Has_Invariants (Typ)) then
Sel_Comp := Make_Explicit_Dereference (Loc, Sel_Comp);
Typ := Designated_Type (Typ);
end if;
end if;
Call :=
@ -3822,9 +3836,14 @@ package body Exp_Ch3 is
return Empty;
end if;
-- The name of the invariant procedure reflects the fact that the
-- checks correspond to invariants on the component types. The
-- record type itself may have invariants that will create a separate
-- procedure whose name carries the Invariant suffix.
Proc_Id :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (R_Type), "Invariant"));
Chars => New_External_Name (Chars (R_Type), "CInvariant"));
Proc_Body :=
Make_Subprogram_Body (Loc,
@ -8045,14 +8064,15 @@ package body Exp_Ch3 is
else
-- Find already created invariant body, insert body of component
-- invariant proc in it, and add call after other checks.
-- Find already created invariant subprogram, insert body of
-- component invariant proc in its body, and add call after
-- other checks.
declare
Bod : Node_Id;
Inv_Id : constant Entity_Id := Invariant_Procedure (Typ);
Call : constant Node_Id :=
Make_Procedure_Call_Statement (Loc,
Make_Procedure_Call_Statement (Sloc (N),
Name => New_Occurrence_Of (Proc_Id, Loc),
Parameter_Associations =>
New_List
@ -8070,8 +8090,22 @@ package body Exp_Ch3 is
Next (Bod);
end loop;
-- If the body is not found, it is the case of an invariant
-- appearing on a full declaration in a private part, in
-- which case the type has been frozen but the invariant
-- procedure for the composite type not created yet. Create
-- body now.
if No (Bod) then
Build_Invariant_Procedure (Typ, Parent (Current_Scope));
Bod := Unit_Declaration_Node
(Corresponding_Body (Unit_Declaration_Node (Inv_Id)));
end if;
Append_To (Declarations (Bod), Proc);
Append_To (Statements (Handled_Statement_Sequence (Bod)), Call);
Analyze (Proc);
Analyze (Call);
end;
end if;
end if;

View File

@ -7485,8 +7485,22 @@ package body Sem_Ch13 is
SId := Invariant_Procedure (Typ);
end if;
-- If the body is already present, nothing to do. This will occur when
-- 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.
if Present (SId) then
PDecl := Unit_Declaration_Node (SId);
if Present (PDecl)
and then Nkind (PDecl) = N_Subprogram_Declaration
and then Present (Corresponding_Body (PDecl))
then
return;
end if;
else
PDecl := Build_Invariant_Procedure_Declaration (Typ);
end if;