The compiler crashes processing an assignment to a discriminated
record type that has pragma Unchecked_Union and Convention C and
is a derivation of a non-tagged record type with discriminants.
After this patch the following test compiles silently.
procedure Conversion is
type small_array is array (0 .. 2) of Integer;
type big_array is array (0 .. 3) of Integer;
type small_record is record
field1 : aliased Integer := 0;
field2 : aliased small_array := (0, 0, 0);
end record;
type big_record is record
field1 : aliased Integer := 0;
field2 : aliased big_array := (0, 0, 0, 0);
end record;
type myUnion (discr : Integer := 0) is record
case discr is
when 0 =>
record1 : aliased small_record;
when others =>
record2 : aliased big_record;
end case;
end record;
type UU_myUnion1 is new myUnion;
pragma Unchecked_Union (UU_myUnion1);
pragma Convention (C, UU_myUnion1);
procedure Convert (A : in myUnion; B : out UU_myUnion1) is
L : UU_myUnion1 := UU_myUnion1 (A); -- Test
begin
B := L;
end Convert;
begin
null;
end Conversion;
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
2017-09-29 Javier Miranda <[email protected]>
* exp_ch5.adb (Expand_Assign_Record): Do not generate code to copy
discriminants if the target is an Unchecked_Union record type.
gcc/testsuite/
2017-09-29 Javier Miranda <[email protected]>
* gnat.dg/unchecked_union3.adb: New testcase.
Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb (revision 253283)
+++ exp_ch5.adb (working copy)
@@ -1577,7 +1577,14 @@
-- suppressed in this case). It is unnecessary but harmless in
-- other cases.
- if Has_Discriminants (L_Typ) then
+ -- Special case: no copy if the target has no discriminants.
+
+ if Has_Discriminants (L_Typ)
+ and then Is_Unchecked_Union (Base_Type (L_Typ))
+ then
+ null;
+
+ elsif Has_Discriminants (L_Typ) then
F := First_Discriminant (R_Typ);
while Present (F) loop
Index: ../testsuite/gnat.dg/unchecked_union3.adb
===================================================================
--- ../testsuite/gnat.dg/unchecked_union3.adb (revision 0)
+++ ../testsuite/gnat.dg/unchecked_union3.adb (revision 0)
@@ -0,0 +1,38 @@
+-- { dg-do compile }
+
+procedure Unchecked_Union3 is
+ type small_array is array (0 .. 2) of Integer;
+ type big_array is array (0 .. 3) of Integer;
+
+ type small_record is record
+ field1 : aliased Integer := 0;
+ field2 : aliased small_array := (0, 0, 0);
+ end record;
+
+ type big_record is record
+ field1 : aliased Integer := 0;
+ field2 : aliased big_array := (0, 0, 0, 0);
+ end record;
+
+ type myUnion (discr : Integer := 0) is record
+ case discr is
+ when 0 =>
+ record1 : aliased small_record;
+ when others =>
+ record2 : aliased big_record;
+ end case;
+ end record;
+
+ type UU_myUnion1 is new myUnion;
+ pragma Unchecked_Union (UU_myUnion1);
+ pragma Convention (C, UU_myUnion1);
+
+ procedure Convert (A : in myUnion; B : out UU_myUnion1) is
+ L : UU_myUnion1 := UU_myUnion1 (A); -- Test
+ begin
+ B := L;
+ end Convert;
+
+begin
+ null;
+end Unchecked_Union3;
