From e693ddbec3e38aeff2e229785b9037ba0caa17c8 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 9 Oct 2018 15:06:35 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 5 ++++ gcc/ada/exp_ch6.adb | 6 +++++ gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gnat.dg/derived_type5.adb | 10 ++++++++ gcc/testsuite/gnat.dg/derived_type5_pkg.ads | 27 +++++++++++++++++++++ 5 files changed, 53 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/derived_type5.adb create mode 100644 gcc/testsuite/gnat.dg/derived_type5_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fada99d05e1..854cadddd51 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2018-10-09 Eric Botcazou + + * 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 * 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 2988f77e3cb..076e0c28e50 100644 --- 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 8196ce74c5c..985635296ea 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-10-09 Eric Botcazou + + * gnat.dg/derived_type5.adb, gnat.dg/derived_type5_pkg.ads: New + testcase. + 2018-10-09 Eric Botcazou * 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 index 00000000000..ff9b615f643 --- /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 index 00000000000..0049791f568 --- /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; -- 2.30.2