public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-187] [Ada] Fix internal error on declaration of derived discriminated record type
@ 2022-05-09 9:31 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-05-09 9:31 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:692a4bf88c5a4743bb5dca47b59a73a83add0fae
commit r13-187-g692a4bf88c5a4743bb5dca47b59a73a83add0fae
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Sat Jan 8 00:48:58 2022 +0100
[Ada] Fix internal error on declaration of derived discriminated record type
When the parent type has a variant part and the derived type is also
discriminated but statically selects a variant, the initialization
routine of the derived type may attempt to access components of other
variants that are no longer present.
gcc/ada/
* exp_ch4.adb (Handle_Changed_Representation): Simplify and fix
thinko in the loop building the constraints for discriminants.
* exp_ch5.adb (Make_Component_List_Assign): Try also to extract
discriminant values for a derived type.
Diff:
---
gcc/ada/exp_ch4.adb | 28 ++++++++++++---------------
gcc/ada/exp_ch5.adb | 56 ++++++++++++++++++++++++++++++++---------------------
2 files changed, 46 insertions(+), 38 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 2506c67e936..09e734defb2 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -11745,31 +11745,24 @@ package body Exp_Ch4 is
declare
Stored : constant Elist_Id :=
Stored_Constraint (Operand_Type);
-
- Elmt : Elmt_Id;
+ -- Stored constraints of the operand. If present, they
+ -- correspond to the discriminants of the parent type.
Disc_O : Entity_Id;
-- Discriminant of the operand type. Its value in the
-- object is captured in a selected component.
- Disc_S : Entity_Id;
- -- Stored discriminant of the operand. If present, it
- -- corresponds to a constrained discriminant of the
- -- parent type.
-
Disc_T : Entity_Id;
-- Discriminant of the target type
+ Elmt : Elmt_Id;
+
begin
- Disc_T := First_Discriminant (Target_Type);
Disc_O := First_Discriminant (Operand_Type);
- Disc_S := First_Stored_Discriminant (Operand_Type);
-
- if Present (Stored) then
- Elmt := First_Elmt (Stored);
- else
- Elmt := No_Elmt; -- init to avoid warning
- end if;
+ Disc_T := First_Discriminant (Target_Type);
+ Elmt := (if Present (Stored)
+ then First_Elmt (Stored)
+ else No_Elmt);
Cons := New_List;
while Present (Disc_T) loop
@@ -11784,8 +11777,11 @@ package body Exp_Ch4 is
Make_Identifier (Loc, Chars (Disc_O))));
Next_Discriminant (Disc_O);
- elsif Present (Disc_S) then
+ elsif Present (Elmt) then
Append_To (Cons, New_Copy_Tree (Node (Elmt)));
+ end if;
+
+ if Present (Elmt) then
Next_Elmt (Elmt);
end if;
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index b78c127e7f4..710db666e8d 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -1848,27 +1848,14 @@ package body Exp_Ch5 is
CI : constant List_Id := Component_Items (CL);
VP : constant Node_Id := Variant_Part (CL);
- Constrained_Typ : Entity_Id;
- Alts : List_Id;
- DC : Node_Id;
- DCH : List_Id;
- Expr : Node_Id;
- Result : List_Id;
- V : Node_Id;
+ Alts : List_Id;
+ DC : Node_Id;
+ DCH : List_Id;
+ Expr : Node_Id;
+ Result : List_Id;
+ V : Node_Id;
begin
- -- Try to find a constrained type to extract discriminant values
- -- from, so that the case statement built below gets an
- -- opportunity to be folded by Expand_N_Case_Statement.
-
- if U_U or else Is_Constrained (Etype (Rhs)) then
- Constrained_Typ := Etype (Rhs);
- elsif Is_Constrained (Etype (Expression (N))) then
- Constrained_Typ := Etype (Expression (N));
- else
- Constrained_Typ := Empty;
- end if;
-
Result := Make_Field_Assigns (CI);
if Present (VP) then
@@ -1890,13 +1877,38 @@ package body Exp_Ch5 is
Next_Non_Pragma (V);
end loop;
- if Present (Constrained_Typ) then
+ -- Try to find a constrained type or a derived type to extract
+ -- discriminant values from, so that the case statement built
+ -- below can be folded by Expand_N_Case_Statement.
+
+ if U_U or else Is_Constrained (Etype (Rhs)) then
+ Expr :=
+ New_Copy (Get_Discriminant_Value (
+ Entity (Name (VP)),
+ Etype (Rhs),
+ Discriminant_Constraint (Etype (Rhs))));
+
+ elsif Is_Constrained (Etype (Expression (N))) then
Expr :=
New_Copy (Get_Discriminant_Value (
Entity (Name (VP)),
- Constrained_Typ,
- Discriminant_Constraint (Constrained_Typ)));
+ Etype (Expression (N)),
+ Discriminant_Constraint (Etype (Expression (N)))));
+
+ elsif Is_Derived_Type (Etype (Rhs))
+ and then Present (Stored_Constraint (Etype (Rhs)))
+ then
+ Expr :=
+ New_Copy (Get_Discriminant_Value (
+ Corresponding_Record_Component (Entity (Name (VP))),
+ Etype (Etype (Rhs)),
+ Stored_Constraint (Etype (Rhs))));
+
else
+ Expr := Empty;
+ end if;
+
+ if No (Expr) or else not Compile_Time_Known_Value (Expr) then
Expr :=
Make_Selected_Component (Loc,
Prefix => Duplicate_Subexpr (Rhs),
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-05-09 9:31 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-05-09 9:31 [gcc r13-187] [Ada] Fix internal error on declaration of derived discriminated record type Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).