The compiler reports an spurious error processing a derived type
of a non-tagged record type that has discriminants, pragma
Unchecked_Union and pragma Convention C.
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_myUnion3 (discr : Integer := 0) is new myUnion (discr); -- Test
pragma Unchecked_Union (UU_myUnion3);
pragma Convention (C, UU_myUnion3);
procedure Convert (A : in UU_myUnion3; B : out UU_myUnion3);
pragma Import (C, 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>
* sem_ch3.adb (Replace_Components): Update references to discriminants
located in variant parts inherited from the parent type.
gcc/testsuite/
2017-09-29 Javier Miranda <mira...@adacore.com>
* gnat.dg/unchecked_union2.adb: New testcase.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 253283)
+++ sem_ch3.adb (working copy)
@@ -21932,6 +21932,17 @@
Next_Discriminant (Comp);
end loop;
+ elsif Nkind (N) = N_Variant_Part then
+ Comp := First_Discriminant (Typ);
+ while Present (Comp) loop
+ if Chars (Comp) = Chars (Name (N)) then
+ Set_Entity (Name (N), Comp);
+ exit;
+ end if;
+
+ Next_Component (Comp);
+ end loop;
+
elsif Nkind (N) = N_Component_Declaration then
Comp := First_Component (Typ);
while Present (Comp) loop
Index: ../testsuite/gnat.dg/unchecked_union2.adb
===================================================================
--- ../testsuite/gnat.dg/unchecked_union2.adb (revision 0)
+++ ../testsuite/gnat.dg/unchecked_union2.adb (revision 0)
@@ -0,0 +1,35 @@
+-- { dg-do compile }
+
+procedure Unchecked_Union2 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_myUnion3 (discr : Integer := 0) is new myUnion (discr); -- Test
+ pragma Unchecked_Union (UU_myUnion3);
+ pragma Convention (C, UU_myUnion3);
+
+ procedure Convert (A : in UU_myUnion3; B : out UU_myUnion3);
+ pragma Import (C, Convert);
+
+begin
+ null;
+end Unchecked_Union2;
