* [Ada] Crash on discriminant check with current instance
@ 2020-12-17 10:50 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2020-12-17 10:50 UTC (permalink / raw)
To: gcc-patches; +Cc: Justin Squirek
[-- Attachment #1: Type: text/plain, Size: 710 bytes --]
This patch fixes an issue in the compiler whereby a reference to the
current instance of the type occurring within a subtype contraint causes
a crash during backend expansion of associated discriminant checks.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* checks.adb (Build_Discriminant_Checks): Add condition to
replace references to the current instance of the type when we
are within an Init_Proc.
(Replace_Current_Instance): Examine a given node and replace the
current instance of the type with the corresponding _init
formal.
(Search_And_Replace_Current_Instance): Traverse proc which calls
Replace_Current_Instance in order to replace all references
within a given expression.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 1989 bytes --]
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -3922,6 +3922,13 @@ package body Checks is
function Aggregate_Discriminant_Val (Disc : Entity_Id) return Node_Id;
+ function Replace_Current_Instance
+ (N : Node_Id) return Traverse_Result;
+ -- Replace a reference to the current instance of the type with the
+ -- corresponding _init formal of the initialization procedure. Note:
+ -- this function relies on us currently being within the initialization
+ -- procedure.
+
--------------------------------
-- Aggregate_Discriminant_Val --
--------------------------------
@@ -3949,6 +3956,26 @@ package body Checks is
raise Program_Error;
end Aggregate_Discriminant_Val;
+ ------------------------------
+ -- Replace_Current_Instance --
+ ------------------------------
+
+ function Replace_Current_Instance
+ (N : Node_Id) return Traverse_Result is
+ begin
+ if Is_Entity_Name (N)
+ and then Etype (N) = Entity (N)
+ then
+ Rewrite (N,
+ New_Occurrence_Of (First_Formal (Current_Subprogram), Loc));
+ end if;
+
+ return OK;
+ end Replace_Current_Instance;
+
+ procedure Search_And_Replace_Current_Instance is new
+ Traverse_Proc (Replace_Current_Instance);
+
-- Start of processing for Build_Discriminant_Checks
begin
@@ -3978,6 +4005,13 @@ package body Checks is
Dval := Duplicate_Subexpr_No_Checks (Dval);
end if;
+ -- Replace references to the current instance of the type with the
+ -- corresponding _init formal of the initialization procedure.
+
+ if Within_Init_Proc then
+ Search_And_Replace_Current_Instance (Dval);
+ end if;
+
-- If we have an Unchecked_Union node, we can infer the discriminants
-- of the node.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-12-17 10:50 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-12-17 10:50 [Ada] Crash on discriminant check with current instance 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).