From adc81ec81db382128869cd62ca4e48bd87d1d880 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 5 Jul 2019 07:02:37 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/exp_ch6.adb | 16 +++++++--------- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/bip_export.adb | 15 +++++++++++++++ gcc/testsuite/gnat.dg/bip_export.ads | 6 ++++++ 5 files changed, 39 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/bip_export.adb create mode 100644 gcc/testsuite/gnat.dg/bip_export.ads 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 + + * 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 * 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 + + * gnat.dg/bip_export.adb, gnat.dg/bip_export.ads: New testcase. + 2019-07-05 Ed Schonberg * 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; -- 2.30.2