Fix uninitialized variable with nested variant record types

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.

gcc/ada/ChangeLog:
	* 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.

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

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 025714bd33946262de44ebefdff3532234f88c79..f85b2b5bbbb49b50b79636d36c26d9e2fdb6c90c 100644 (file)
--- 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);
       }

diff --git a/gcc/testsuite/gnat.dg/discr59.adb b/gcc/testsuite/gnat.dg/discr59.adb
new file mode 100644 (file)
index 0000000..59e1b5f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr59.adb
@@ -0,0 +1,24 @@
+-- { 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;

diff --git a/gcc/testsuite/gnat.dg/discr59_pkg1.ads b/gcc/testsuite/gnat.dg/discr59_pkg1.ads
new file mode 100644 (file)
index 0000000..455250b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr59_pkg1.ads
@@ -0,0 +1,35 @@
+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;

diff --git a/gcc/testsuite/gnat.dg/discr59_pkg2.ads b/gcc/testsuite/gnat.dg/discr59_pkg2.ads
new file mode 100644 (file)
index 0000000..01ed509
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr59_pkg2.ads
@@ -0,0 +1,15 @@
+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;