[multiple changes]
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:
parent
bd1f29d927
commit
b48a653174
|
@ -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>
|
2008-04-15 Samuel Tardieu <sam@rfc1149.net>
|
||||||
Gary Dismukes <dismukes@adacore.com>
|
Gary Dismukes <dismukes@adacore.com>
|
||||||
|
|
||||||
|
|
|
@ -1345,13 +1345,30 @@ package body Exp_Ch5 is
|
||||||
F := First_Discriminant (R_Typ);
|
F := First_Discriminant (R_Typ);
|
||||||
while Present (F) loop
|
while Present (F) loop
|
||||||
|
|
||||||
if Is_Unchecked_Union (Base_Type (R_Typ)) then
|
-- If we are expanding the initialization of a derived record
|
||||||
Insert_Action (N, Make_Field_Assign (F, True));
|
-- that constrains or renames discriminants of the parent, we
|
||||||
|
-- must use the corresponding discriminant in the parent.
|
||||||
|
|
||||||
|
declare
|
||||||
|
CF : Entity_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Inside_Init_Proc
|
||||||
|
and then Present (Corresponding_Discriminant (F))
|
||||||
|
then
|
||||||
|
CF := Corresponding_Discriminant (F);
|
||||||
else
|
else
|
||||||
Insert_Action (N, Make_Field_Assign (F));
|
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;
|
end if;
|
||||||
|
|
||||||
Next_Discriminant (F);
|
Next_Discriminant (F);
|
||||||
|
end;
|
||||||
end loop;
|
end loop;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
|
@ -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>
|
2008-04-15 Eric Botcazou <ebotcazou@adacore.com>
|
||||||
|
|
||||||
* gnat.dg/string_slice2.adb: New test.
|
* gnat.dg/string_slice2.adb: New test.
|
||||||
|
|
|
@ -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;
|
||||||
|
|
Loading…
Reference in New Issue