[Ada] Crash on compilation unit function that builds in place

This patch fixes a crash on a function that builds its limited result in
place. Previously this was handled properly only if the function was a
child unit.

2018-12-11  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch3.adb (Build_Itype_Reference): Handle properly an itype
	reference created for a function that is a compilation unit, for
	example if the function builds in place an object of a limited
	type.

gcc/testsuite/

	* gnat.dg/bip_cu.adb, gnat.dg/bip_cu_constructor.adb,
	gnat.dg/bip_cu_constructor.ads, gnat.dg/bip_cu_t.adb,
	gnat.dg/bip_cu_t.ads: New testcase.

From-SVN: r266999

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 34c3a2fad4a3994d4b8153a9064817f867db7620..76c6e761e00434ba8150ff619a82272d6277b9b7 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-12-11  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Build_Itype_Reference): Handle properly an itype
+       reference created for a function that is a compilation unit, for
+       example if the function builds in place an object of a limited
+       type.
+
 2018-12-11  Dmitriy Anisimkov  <anisimko@adacore.com>
 
        * libgnat/g-socket.ads, libgnat/g-socket.adb: Fix duration

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index d99370ae6bb7f7395e191f1bf47baf1d1ac04530..5195f8a267b3bc9c5d999d7ba14de06a447dfdb8 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -10368,12 +10368,13 @@ package body Sem_Ch3 is
          --  If Nod is a library unit entity, then Insert_After won't work,
          --  because Nod is not a member of any list. Therefore, we use
          --  Add_Global_Declaration in this case. This can happen if we have a
-         --  build-in-place library function.
+         --  build-in-place library function, child unit or not.
 
          if (Nkind (Nod) in N_Entity and then Is_Compilation_Unit (Nod))
            or else
-             (Nkind (Nod) = N_Defining_Program_Unit_Name
-               and then Is_Compilation_Unit (Defining_Identifier (Nod)))
+             (Nkind_In (Nod,
+                N_Defining_Program_Unit_Name, N_Subprogram_Declaration)
+               and then Is_Compilation_Unit (Defining_Entity (Nod)))
          then
             Add_Global_Declaration (IR);
          else

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d5c371c5c5e17e8c3a7c303160a4c607e071535b..3bc15f08521d5152d4a68dcb181a41d2c5b3ff8b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2018-12-11  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/bip_cu.adb, gnat.dg/bip_cu_constructor.adb,
+       gnat.dg/bip_cu_constructor.ads, gnat.dg/bip_cu_t.adb,
+       gnat.dg/bip_cu_t.ads: New testcase.
+
 2018-12-11  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * gnat.dg/ghost2.adb, gnat.dg/ghost2.ads: New testcase.

diff --git a/gcc/testsuite/gnat.dg/bip_cu.adb b/gcc/testsuite/gnat.dg/bip_cu.adb
new file mode 100644 (file)
index 0000000..39790cd
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bip_cu.adb
@@ -0,0 +1,10 @@
+--  { dg-do compile }
+
+with BIP_CU_T; use BIP_CU_T;
+with BIP_CU_Constructor;
+
+procedure BIP_CU is
+    Value : constant T := BIP_CU_Constructor;
+begin
+    null;
+end;

diff --git a/gcc/testsuite/gnat.dg/bip_cu_constructor.adb b/gcc/testsuite/gnat.dg/bip_cu_constructor.adb
new file mode 100644 (file)
index 0000000..7ed3cab
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bip_cu_constructor.adb
@@ -0,0 +1,5 @@
+with BIP_CU_T; use BIP_CU_T;
+function BIP_CU_Constructor return T is
+begin
+   return Make_T (Name => "Rumplestiltskin");
+end BIP_CU_Constructor;

diff --git a/gcc/testsuite/gnat.dg/bip_cu_constructor.ads b/gcc/testsuite/gnat.dg/bip_cu_constructor.ads
new file mode 100644 (file)
index 0000000..ed77cf4
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bip_cu_constructor.ads
@@ -0,0 +1,2 @@
+with BIP_CU_T; use BIP_CU_T;
+function BIP_CU_Constructor return T;

diff --git a/gcc/testsuite/gnat.dg/bip_cu_t.adb b/gcc/testsuite/gnat.dg/bip_cu_t.adb
new file mode 100644 (file)
index 0000000..bf005b1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bip_cu_t.adb
@@ -0,0 +1,8 @@
+package body BIP_CU_T is
+
+   function Make_T (Name : String) return T is
+   begin
+      return (Name => To_Unbounded_String (Name), others => <>);
+   end Make_T;
+
+end BIP_CU_T;

diff --git a/gcc/testsuite/gnat.dg/bip_cu_t.ads b/gcc/testsuite/gnat.dg/bip_cu_t.ads
new file mode 100644 (file)
index 0000000..75e97b9
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bip_cu_t.ads
@@ -0,0 +1,10 @@
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+package BIP_CU_T is
+   type T is limited private;
+   function Make_T (Name : String) return T;
+private
+   type T is limited record
+      Name : Unbounded_String;
+   end record;
+end BIP_CU_T;