procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2008-04-15  Ed Schonberg  <schonberg@adacore.com>

    gcc/ada/
	PR ada/22387
	* exp_ch5.adb (Expand_Assign_Record): Within an initialization
	procedure for a derived type retrieve the discriminant values from
	the parent using the corresponding discriminant.

2008-04-15  Samuel Tardieu  <sam@rfc1149.net>

    gcc/testsuite/
	PR ada/22387
	* gnat.dg/specs/corr_discr.ads: New.

From-SVN: r134326
This commit is contained in:
Samuel Tardieu 2008-04-15 19:05:29 +00:00
parent bd1f29d927
commit b48a653174
4 changed files with 48 additions and 6 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 @@
2008-04-15 Ed Schonberg <schonberg@adacore.com>
PR ada/22387
* exp_ch5.adb (Expand_Assign_Record): Within an initialization
procedure for a derived type retrieve the discriminant values from
the parent using the corresponding discriminant.
2008-04-15 Samuel Tardieu <sam@rfc1149.net>
Gary Dismukes <dismukes@adacore.com>

29
gcc/ada/exp_ch5.adb
View file

@ -1345,13 +1345,30 @@ package body Exp_Ch5 is
F := First_Discriminant (R_Typ);
while Present (F) loop
if Is_Unchecked_Union (Base_Type (R_Typ)) then
Insert_Action (N, Make_Field_Assign (F, True));
else
Insert_Action (N, Make_Field_Assign (F));
end if;
-- If we are expanding the initialization of a derived record
-- that constrains or renames discriminants of the parent, we
-- must use the corresponding discriminant in the parent.
Next_Discriminant (F);
declare
CF : Entity_Id;
begin
if Inside_Init_Proc
and then Present (Corresponding_Discriminant (F))
then
CF := Corresponding_Discriminant (F);
else
CF := F;
end if;
if Is_Unchecked_Union (Base_Type (R_Typ)) then
Insert_Action (N, Make_Field_Assign (CF, True));
else
Insert_Action (N, Make_Field_Assign (CF));
end if;
Next_Discriminant (F);
end;
end loop;
end if;

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2008-04-15 Samuel Tardieu <sam@rfc1149.net>
PR ada/22387
* gnat.dg/specs/corr_discr.ads: New.
2008-04-15 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/string_slice2.adb: New test.

13
gcc/testsuite/gnat.dg/specs/corr_discr.ads Normal file
View file

@ -0,0 +1,13 @@
package Corr_Discr is
type Base (T1 : Boolean := True; T2 : Boolean := False)
is null record;
for Base use record
T1 at 0 range 0 .. 0;
T2 at 0 range 1 .. 1;
end record;
type Deriv (D : Boolean := False) is new Base (T1 => True, T2 => D);
end Corr_Discr;