[Ada] Fix spurious error on derived record passed as Out parameter

Message ID 20181009150928.GA123339@adacore.com
State New
Headers show
Series
  • [Ada] Fix spurious error on derived record passed as Out parameter
Related show

Commit Message

Pierre-Marie de Rodat Oct. 9, 2018, 3:09 p.m.
This fixlet gets rid of a spurious error issued in the specific case of
a call to a subprogram taking an Out parameter of a discriminated record
type without default discriminants, if the actual parameter is the
result of the conversion to the record type of a variable whose type is
derived from the record and has a representation clause.

The compiler was failing to initialize the temporary made around the
call because of the representation clause, but this is required for a
type with discriminants because discriminants may be read by the called
subprogram.

Tested on x86_64-pc-linux-gnu, committed on trunk

2018-10-09  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch6.adb (Add_Call_By_Copy_Code): Initialize the temporary
	made for an Out parameter if the formal type has discriminants.

gcc/testsuite/

	* gnat.dg/derived_type5.adb, gnat.dg/derived_type5_pkg.ads: New
	testcase.

Patch

--- gcc/ada/exp_ch6.adb
+++ gcc/ada/exp_ch6.adb
@@ -1321,8 +1321,14 @@  package body Exp_Ch6 is
          --  bounds of the actual and build an uninitialized temporary of the
          --  right size.
 
+         --  If the formal is an out parameter with discriminants, the
+         --  discriminants must be captured even if the rest of the object
+         --  is in principle uninitialized, because the discriminants may
+         --  be read by the called subprogram.
+
          if Ekind (Formal) = E_In_Out_Parameter
            or else (Is_Array_Type (F_Typ) and then not Is_Constrained (F_Typ))
+           or else Has_Discriminants (F_Typ)
          then
             if Nkind (Actual) = N_Type_Conversion then
                if Conversion_OK (Actual) then

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/derived_type5.adb
@@ -0,0 +1,10 @@ 
+--  { dg-do compile }
+
+with Derived_Type5_Pkg; use Derived_Type5_Pkg;
+
+procedure Derived_Type5 is
+  D : Derived;
+begin
+  Proc1 (Rec (D));
+  Proc2 (Rec (D));
+end;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/derived_type5_pkg.ads
@@ -0,0 +1,27 @@ 
+package Derived_Type5_Pkg is
+
+   type T_Unsigned8  is new Natural range 0 .. (2 ** 8 - 1);
+
+   type Rec (Discriminant : T_Unsigned8) is record
+      Fixed_Field : T_Unsigned8;
+      case Discriminant is
+         when 0 =>
+            Optional_Field : T_unsigned8;
+         when others =>
+            null;
+      end case;
+   end record;
+
+   type Derived is new Rec (0);
+
+   for Derived use record
+      Fixed_Field    at 0 range 0  .. 7;
+      Discriminant   at 0 range 8  .. 15;
+      Optional_Field at 0 range 16 .. 23;
+   end record;
+
+   procedure Proc1 (R : in out Rec);
+
+   procedure Proc2 (R : out Rec);
+
+end Derived_Type5_Pkg;