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.
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.