[Ada] Fix uninitialized variable with nested variant record types

[Eric Botcazou]

This fixes a wrong code issue with nested variant record types: the compiler 
generates move instructions that depend on an uninitialized variable, which 
was initially a SAVE_EXPR not instantiated early enough.

Tested on x86_64-suse-linux, applied on mainline, 10 and 9 branches.


2020-09-10  Eric Botcazou  <ebotca...@adacore.com>

        * gcc-interface/decl.c (build_subst_list): For a definition, make
        sure to instantiate the SAVE_EXPRs generated by the elaboration of
        the constraints in front of the elaboration of the type itself.


2020-09-10  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/discr59.adb: New test.
        * gnat.dg/discr59_pkg1.ads: New helper.
        * gnat.dg/discr59_pkg2.ads: Likewise.

-- 
Eric Botcazou
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 025714bd339..f85b2b5bbbb 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -8849,11 +8849,15 @@ build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition)
     if (!Is_Access_Type (Etype (Node (gnat_constr))))
       {
 	tree gnu_field = gnat_to_gnu_field_decl (gnat_discrim);
-	tree replacement = convert (TREE_TYPE (gnu_field),
-				    elaborate_expression
-				    (Node (gnat_constr), gnat_subtype,
-				     get_entity_char (gnat_discrim),
-				     definition, true, false));
+	tree replacement
+	  = elaborate_expression (Node (gnat_constr), gnat_subtype,
+				  get_entity_char (gnat_discrim),
+				  definition, true, false);
+	/* If this is a definition, we need to make sure that the SAVE_EXPRs
+	   are instantiated on every possibly path in size computations.  */
+	if (definition && TREE_CODE (replacement) == SAVE_EXPR)
+	  add_stmt (replacement);
+	replacement = convert (TREE_TYPE (gnu_field), replacement);
 	subst_pair s = { gnu_field, replacement };
 	gnu_list.safe_push (s);
       }

-- { dg-do run }

with Discr59_Pkg1; use Discr59_Pkg1;

procedure Discr59 is

   function At_Response_Decode return At_Response_Type is
      Fill : At_Response_Type (Alert, 1);
   begin
      return Fill;
   end;

   function Decode return Rec is
      Make : constant At_Response_Type := At_Response_Decode;
      Fill : Rec (At_Response, Make.Kind, Make.Units);
   begin
      return Fill;
   end;

   R : constant Rec := Decode;

begin
   null;
end;

generic

   Max_Length : Positive;

package Discr59_Pkg2 is

   type Token_Base_Type (Most : Natural) is record
      Text : String (1 .. Most) := (others => ' ');
      Last : Natural            := 0;
      Used : Natural            := 0;
   end record;

   type Token_Type is new Token_Base_Type (Max_Length);

end Discr59_Pkg2;

with Discr59_Pkg2;

package Discr59_Pkg1 is

   subtype Index_Type is Natural range 1 .. 300;

   type Code_Type is (Global_Query, Status_Query, Alert);

   type Id_Type is (None, At_Command, At_Response);

   package My_G is new Discr59_Pkg2 (21);

   type Arr is array (Index_Type range <>) of My_G.Token_Type;

   type Unit_List_Type (Last : Natural) is record
      A : Arr (1 .. Last);
   end record;

   type At_Response_Type (Kind : Code_Type; Units : Natural) is record
      case Kind is
         when Global_Query => Global_Query : Unit_List_Type (Units);
         when Status_Query => null;
         when Alert        => Alert : Unit_List_Type (Units);
      end case;
   end record;

   type Rec (Kind : Id_Type; Code : Code_Type; Units : Natural) is record
      case Kind is
         when None        => null;
         when At_Command  => null;
         when At_Response => At_Response : At_Response_Type (Code, Units);
      end case;
   end record;

end Discr59_Pkg1;