From f6219730a1ac4a24cbbc2428e3f30e1b11abe1e8 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Thu, 3 Dec 2020 10:06:26 -0500 Subject: [PATCH] [Ada] Crash on discriminant check with current instance 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. --- gcc/ada/checks.adb | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index f4757108478..891c4c86244 100644 --- 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. -- 2.30.2