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

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.

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.

From-SVN: r264980

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fada99d05e1c019dbb46305f74fe10d37bd599f5..854cadddd516898723749dacbe478e55e6d47a6a 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2018-10-09  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * exp_ch6.adb (Add_Call_By_Copy_Code): Initialize the temporary
+       made for an Out parameter if the formal type has discriminants.
+
 2018-10-09  Maroua Maalej  <maalej@adacore.com>
 
        * sem_spark.adb (Check_Declaration): fix bug related to non

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 2988f77e3cb6485cc26abeba13bf542c7cc38e5b..076e0c28e506ef2e7ec65ef1888637190da274fe 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8196ce74c5c315e8039e85e9091068b71cd83e78..985635296ea37e0261f0c99ae1491bfa73828173 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-10-09  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/derived_type5.adb, gnat.dg/derived_type5_pkg.ads: New
+       testcase.
+
 2018-10-09  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/warn17.adb: New testcase.

diff --git a/gcc/testsuite/gnat.dg/derived_type5.adb b/gcc/testsuite/gnat.dg/derived_type5.adb
new file mode 100644 (file)
index 0000000..ff9b615
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/derived_type5_pkg.ads b/gcc/testsuite/gnat.dg/derived_type5_pkg.ads
new file mode 100644 (file)
index 0000000..0049791
--- /dev/null
+++ b/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;