From 71465223b95af43951c423ad77391e706f02901d Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 10 Sep 2020 17:47:32 +0200 Subject: [PATCH] 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. --- gcc/ada/gcc-interface/decl.c | 14 +++++++---- gcc/testsuite/gnat.dg/discr59.adb | 24 ++++++++++++++++++ gcc/testsuite/gnat.dg/discr59_pkg1.ads | 35 ++++++++++++++++++++++++++ gcc/testsuite/gnat.dg/discr59_pkg2.ads | 15 +++++++++++ 4 files changed, 83 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/discr59.adb create mode 100644 gcc/testsuite/gnat.dg/discr59_pkg1.ads create mode 100644 gcc/testsuite/gnat.dg/discr59_pkg2.ads 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); } diff --git a/gcc/testsuite/gnat.dg/discr59.adb b/gcc/testsuite/gnat.dg/discr59.adb new file mode 100644 index 00000000000..59e1b5fc290 --- /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 index 00000000000..455250b33e9 --- /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 index 00000000000..01ed5090ebd --- /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; -- 2.30.2