Commit e693ddbe by Eric Botcazou Committed by Pierre-Marie de Rodat

[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
parent 38c2f655
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
......
......@@ -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
......
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.
2018-10-09 Eric Botcazou <ebotcazou@adacore.com>
......
-- { 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;
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment