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 <ebotca...@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.--- 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;
