From: Hristian Kirtchev <kirtchev@adacore.com>
Date: Thu, 24 May 2018 13:04:24 +0000 (+0000)
Subject: [Ada] Crash on compilation unit instance
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7dcac7d1468a3b5b69f5a04d2ca0919b515fddba;p=gcc.git

[Ada] Crash on compilation unit instance

Do not generate a variable marker for a reference which appears within the
formal part of an instantiation which acts as a compilation unit because
there is no suitable insertion context.

------------
-- Source --
------------

--  gnat.adc

pragma SPARK_Mode (On);

--  gen.ads

generic
   Val_1 : Integer;
   Val_2 : Integer;
package Gen is
end Gen;

--  pack.ads

package Pack is
   Val : Integer := 123;

   function Get_Val return Integer;
end Pack;

--  inst.ads

with Gen;
with Pack; use Pack;

package Inst is new Gen (Val, Get_Val);

--  proc.adb

with Pack; use Pack;

procedure Proc (Val_1 : Integer := Val; Val_2 : Integer := Get_Val) is
begin null; end Proc;

-----------------
-- Compilation --
-----------------

$ gcc -c inst.ads
$ gcc -c inst.ads -gnatd.F
$ gcc -c proc.adb
$ gcc -c proc.adb -gnatd.F

2018-05-24  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* sem_elab.adb (Build_Variable_Reference_Marker): Do not create a
	variable marker when the reference appears in the formal part of a
	compilation unit instance because there is no place to insert it.
	(In_Compilation_Instance_Formal_Part): New routine.

From-SVN: r260643
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c6ff69047ed..8d4b0fc3be8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-05-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_elab.adb (Build_Variable_Reference_Marker): Do not create a
+	variable marker when the reference appears in the formal part of a
+	compilation unit instance because there is no place to insert it.
+	(In_Compilation_Instance_Formal_Part): New routine.
+
 2018-05-24  Piotr Trojanek  <trojanek@adacore.com>
 
 	* layout.ads, repinfo.ads: Fix references to renamed Backend_Layout
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index cfc21b1fb95..0b7fcb49493 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -2274,9 +2274,44 @@ package body Sem_Elab is
       Read  : Boolean;
       Write : Boolean)
    is
+      function In_Compilation_Instance_Formal_Part
+        (Nod : Node_Id) return Boolean;
+      --  Determine whether arbitrary node Nod appears within the formal part
+      --  of an instantiation which acts as a compilation unit.
+
       function In_Pragma (Nod : Node_Id) return Boolean;
       --  Determine whether arbitrary node Nod appears within a pragma
 
+      -----------------------------------------
+      -- In_Compilation_Instance_Formal_Part --
+      -----------------------------------------
+
+      function In_Compilation_Instance_Formal_Part
+        (Nod : Node_Id) return Boolean
+      is
+         Par : Node_Id;
+
+      begin
+         Par := Nod;
+         while Present (Par) loop
+            if Nkind (Par) = N_Generic_Association
+              and then Nkind (Parent (Par)) in N_Generic_Instantiation
+              and then Nkind (Parent (Parent (Par))) = N_Compilation_Unit
+            then
+               return True;
+
+            --  Prevent the search from going too far
+
+            elsif Is_Body_Or_Package_Declaration (Par) then
+               exit;
+            end if;
+
+            Par := Parent (Par);
+         end loop;
+
+         return False;
+      end In_Compilation_Instance_Formal_Part;
+
       ---------------
       -- In_Pragma --
       ---------------
@@ -2349,6 +2384,15 @@ package body Sem_Elab is
                   and then Entity (N) /= Any_Id)
       then
          return;
+
+      --  Nothing to do when the reference appears within the formal part of
+      --  an instantiation which acts as compilation unit because there is no
+      --  proper context for the insertion of the marker.
+
+      --  Performance note: parent traversal
+
+      elsif In_Compilation_Instance_Formal_Part (N) then
+         return;
       end if;
 
       Extract_Variable_Reference_Attributes