[Ada] Pragma Unchecked_Union on derived discriminated type

[Ada] Pragma Unchecked_Union on derived discriminated type

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 1489 bytes --]

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  <miranda@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  <miranda@adacore.com>

	* gnat.dg/unchecked_union2.adb: New testcase.

[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 1968 bytes --]

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;