mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-28 01:00:45 +08:00
Code Issues Packages Projects Releases Wiki Activity

exp_aggr.adb (Build_Array_Aggr_Code, Gen_Assign): If a component is default-initialized and its type has an invariant procedure...

Browse Source 
2015-05-26  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Build_Array_Aggr_Code, Gen_Assign):
	If a component is default-initialized and its type has an
	invariant procedure, insert an invariant test after code for
	default-initialization of the component.

From-SVN: r223664
This commit is contained in:
Ed Schonberg 2015-05-26 08:10:46 +00:00 committed by Arnaud Charlet
parent 551e193501
commit ffcfb997e0
2 changed files with 34 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/ada/ChangeLog
View File

@ -1,3 +1,10 @@
2015-05-26 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Build_Array_Aggr_Code, Gen_Assign):
If a component is default-initialized and its type has an
invariant procedure, insert an invariant test after code for
default-initialization of the component.
2015-05-26 Gary Dismukes <dismukes@adacore.com> 2015-05-26 Gary Dismukes <dismukes@adacore.com>
* einfo.ads, sem_util.adb, sem_ch4.adb: Minor reformatting. * einfo.ads, sem_util.adb, sem_ch4.adb: Minor reformatting.

24
gcc/ada/exp_aggr.adb
View File

@ -1160,6 +1160,16 @@ package body Exp_Aggr is
Typ => Ctype, Typ => Ctype,
With_Default_Init => True)); With_Default_Init => True));
-- If the component type has invariants, add an invariant
-- check after the component is default-initialized. It will
-- be analyzed and resolved before the code for initialization
-- of other components.
if Has_Invariants (Ctype) then
Set_Etype (Indexed_Comp, Ctype);
Append_To (L, Make_Invariant_Call (Indexed_Comp));
end if;
elsif Is_Access_Type (Ctype) then elsif Is_Access_Type (Ctype) then
Append_To (L, Append_To (L,
Make_Assignment_Statement (Loc, Make_Assignment_Statement (Loc,
@ -1911,8 +1921,7 @@ package body Exp_Aggr is
return Duplicate_Subexpr (Expression (Assoc)); return Duplicate_Subexpr (Expression (Assoc));
end if; end if;
Corresp_Disc := Corresp_Disc := Corresponding_Discriminant (Corresp_Disc);
Corresponding_Discriminant (Corresp_Disc);
end loop; end loop;
end if; end if;
@ -1954,8 +1963,7 @@ package body Exp_Aggr is
while Present (Corresp_Disc) while Present (Corresp_Disc)
and then Disc /= Corresp_Disc and then Disc /= Corresp_Disc
loop loop
Corresp_Disc := Corresp_Disc := Corresponding_Discriminant (Corresp_Disc);
Corresponding_Discriminant (Corresp_Disc);
end loop; end loop;
if Disc = Corresp_Disc then if Disc = Corresp_Disc then
@ -1984,8 +1992,10 @@ package body Exp_Aggr is
if No (Assoc_Elmt) then if No (Assoc_Elmt) then
Next (Assoc); Next (Assoc);
else else
Next_Elmt (Assoc_Elmt); Next_Elmt (Assoc_Elmt);
if Present (Assoc_Elmt) then if Present (Assoc_Elmt) then
Assoc := Node (Assoc_Elmt); Assoc := Node (Assoc_Elmt);
else else
@ -2617,8 +2627,8 @@ package body Exp_Aggr is
Selector_Name => New_Occurrence_Of (Discriminant, Loc)); Selector_Name => New_Occurrence_Of (Discriminant, Loc));
Discriminant_Value := Discriminant_Value :=
Get_Discriminant_Value ( Get_Discriminant_Value
Discriminant, (Discriminant,
N_Typ, N_Typ,
Discriminant_Constraint (N_Typ)); Discriminant_Constraint (N_Typ));
@ -2670,7 +2680,7 @@ package body Exp_Aggr is
if Present (CPP_Init_Proc (T)) then if Present (CPP_Init_Proc (T)) then
Append_To (L, Append_To (L,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
New_Occurrence_Of (CPP_Init_Proc (T), Loc))); Name => New_Occurrence_Of (CPP_Init_Proc (T), Loc)));
end if; end if;
end Invoke_IC_Proc; end Invoke_IC_Proc;