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

1 files changed, 34 insertions, 0 deletions

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index f475710..891c4c8 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.