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 <mira...@adacore.com> * 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 <mira...@adacore.com> * 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;