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.
This commit is contained in:
parent
66a204a656
commit
71465223b9
4 changed files with 83 additions and 5 deletions
|
@ -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);
|
||||
}
|
||||
|
|
24
gcc/testsuite/gnat.dg/discr59.adb
Normal file
24
gcc/testsuite/gnat.dg/discr59.adb
Normal file
|
@ -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;
|
35
gcc/testsuite/gnat.dg/discr59_pkg1.ads
Normal file
35
gcc/testsuite/gnat.dg/discr59_pkg1.ads
Normal file
|
@ -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;
|
15
gcc/testsuite/gnat.dg/discr59_pkg2.ads
Normal file
15
gcc/testsuite/gnat.dg/discr59_pkg2.ads
Normal file
|
@ -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;
|
Loading…
Add table
Reference in a new issue