From: Bob Duff <duff@adacore.com>
Date: Fri, 5 Jul 2019 07:02:37 +0000 (+0000)
Subject: [Ada] Crash on exported build-in-place function
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=adc81ec81db382128869cd62ca4e48bd87d1d880;p=gcc.git

[Ada] Crash on exported build-in-place function

This patch fixes a bug where if a function is build-in-place, and is
exported, and contains an extended_return_statement whose object is
initialized with another build-in-place function call, then the compiler
will crash.

2019-07-05  Bob Duff  <duff@adacore.com>

gcc/ada/

	* exp_ch6.adb (Is_Build_In_Place_Function): Narrow the check for
	Has_Foreign_Convention to the imported case only.  If a
	build-in-place function is exported, and called from Ada code,
	build-in-place protocols should be used.

gcc/testsuite/

	* gnat.dg/bip_export.adb, gnat.dg/bip_export.ads: New testcase.

From-SVN: r273113
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cac6be71dc2..880f2610bf4 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-05  Bob Duff  <duff@adacore.com>
+
+	* exp_ch6.adb (Is_Build_In_Place_Function): Narrow the check for
+	Has_Foreign_Convention to the imported case only.  If a
+	build-in-place function is exported, and called from Ada code,
+	build-in-place protocols should be used.
+
 2019-07-05  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_util.adb (Encloing_Subprogram): If Enclosing_Dynamic_Scope
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index bd7ae2c8734..db9484f57f5 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7765,22 +7765,20 @@ package body Exp_Ch6 is
 
       --  For now we test whether E denotes a function or access-to-function
       --  type whose result subtype is inherently limited. Later this test
-      --  may be revised to allow composite nonlimited types. Functions with
-      --  a foreign convention or whose result type has a foreign convention
-      --  never qualify.
+      --  may be revised to allow composite nonlimited types.
 
       if Ekind_In (E, E_Function, E_Generic_Function)
         or else (Ekind (E) = E_Subprogram_Type
                   and then Etype (E) /= Standard_Void_Type)
       then
-         --  Note: If the function has a foreign convention, it cannot build
-         --  its result in place, so you're on your own. On the other hand,
-         --  if only the return type has a foreign convention, its layout is
-         --  intended to be compatible with the other language, but the build-
-         --  in place machinery can ensure that the object is not copied.
+         --  If the function is imported from a foreign language, we don't do
+         --  build-in-place. Note that Import (Ada) functions can do
+         --  build-in-place. Note that it is OK for a build-in-place function
+         --  to return a type with a foreign convention; the build-in-place
+         --  machinery will ensure there is no copying.
 
          return Is_Build_In_Place_Result_Type (Etype (E))
-           and then not Has_Foreign_Convention (E)
+           and then not (Has_Foreign_Convention (E) and then Is_Imported (E))
            and then not Debug_Flag_Dot_L;
       else
          return False;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 82b8c22901c..3bd1aab7195 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-05  Bob Duff  <duff@adacore.com>
+
+	* gnat.dg/bip_export.adb, gnat.dg/bip_export.ads: New testcase.
+
 2019-07-05  Ed Schonberg  <schonberg@adacore.com>
 
 	* gnat.dg/aggr25.adb, gnat.dg/aggr25.ads: New testcase.
diff --git a/gcc/testsuite/gnat.dg/bip_export.adb b/gcc/testsuite/gnat.dg/bip_export.adb
new file mode 100644
index 00000000000..2935a84424d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bip_export.adb
@@ -0,0 +1,15 @@
+--  { dg-do compile }
+
+package body Bip_Export is
+   function F return T is
+   begin
+      return Result : constant T := G do
+         null;
+      end return;
+   end F;
+
+   function G return T is
+   begin
+      return (null record);
+   end G;
+end Bip_Export;
diff --git a/gcc/testsuite/gnat.dg/bip_export.ads b/gcc/testsuite/gnat.dg/bip_export.ads
new file mode 100644
index 00000000000..dbbecf5ae80
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bip_export.ads
@@ -0,0 +1,6 @@
+package Bip_Export is
+   type T is limited null record;
+   function F return T;
+   pragma Export (C, F);
+   function G return T;
+end Bip_Export;