Fix internal error on function call returning extension of limited interface

The problem occurs when this function call is the expression of a return in
a function returning the limited interface; in this peculiar case, there is
a mismatch between the callee, which has BIP formals but is not a BIP call,
and the caller, which is a BIP function, that is spotted by an assertion.

This is fixed by restoring the semantics of Is_Build_In_Place_Function_Call,
which returns again true only for calls to BIP functions, introducing the
Is_Function_Call_With_BIP_Formals predicate, which also returns true for
calls to functions with BIP formals that are not BIP functions, and moving
down the assertion in Expand_Simple_Function_Return.

gcc/ada/
	PR ada/112781
	* exp_ch6.ads (Is_Build_In_Place_Function): Adjust description.
	* exp_ch6.adb (Is_True_Build_In_Place_Function_Call): Delete.
	(Is_Function_Call_With_BIP_Formals): New predicate.
	(Is_Build_In_Place_Function_Call): Restore original semantics.
	(Expand_Call_Helper): Adjust conditions guarding the calls to
	Add_Dummy_Build_In_Place_Actuals to above renaming.
	(Expand_N_Extended_Return_Statement): Adjust to above renaming.
	(Expand_Simple_Function_Return): Likewise.  Move the assertion
	to after the transformation into an extended return statement.
	(Make_Build_In_Place_Call_In_Allocator): Remove unreachable code.
	(Make_Build_In_Place_Call_In_Assignment): Likewise.

gcc/testsuite/
	* gnat.dg/bip_prim_func2.adb: New test.
	* gnat.dg/bip_prim_func2_pkg.ads, gnat.dg/bip_prim_func2_pkg.adb:
	New helper package.

3 files changed, 63 insertions, 0 deletions

diff --git a/gcc/testsuite/gnat.dg/bip_prim_func2.adb b/gcc/testsuite/gnat.dg/bip_prim_func2.adb
new file mode 100644
index 0000000..e139c89
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bip_prim_func2.adb
@@ -0,0 +1,23 @@
+--  { dg-do run }
+
+with BIP_Prim_Func2_Pkg;
+
+procedure BIP_Prim_Func2 is
+
+   package B is
+      type Instance is limited interface;
+      function Make return Instance is abstract;
+   end B;
+
+   package C is
+      type Instance is new B.Instance with null record;
+      function Make return Instance is (null record);
+   end C;
+
+   package T is new BIP_Prim_Func2_Pkg (B.Instance, C.Instance, C.Make);
+
+   Thing : B.Instance'Class := T.Make (2);
+
+begin
+   null;
+end;
diff --git a/gcc/testsuite/gnat.dg/bip_prim_func2_pkg.adb b/gcc/testsuite/gnat.dg/bip_prim_func2_pkg.adb
new file mode 100644
index 0000000..5a4591a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bip_prim_func2_pkg.adb
@@ -0,0 +1,23 @@
+with Ada.Containers.Indefinite_Ordered_Maps;
+
+package body BIP_Prim_Func2_Pkg is
+
+   package Maps is new Ada.Containers.Indefinite_Ordered_Maps
+     (Key_Type     => Integer,
+      Element_Type => Some_Access);
+
+   Map : Maps.Map;
+
+   function Make (Key : Integer) return First'Class is
+   begin
+      return Map(Key).all;
+   end Make;
+
+   function Make_Delegate return First'Class is
+   begin
+      return Make;
+   end Make_Delegate;
+
+begin
+   Map.Insert (2,Thing_Access);
+end BIP_Prim_Func2_Pkg;
diff --git a/gcc/testsuite/gnat.dg/bip_prim_func2_pkg.ads b/gcc/testsuite/gnat.dg/bip_prim_func2_pkg.ads
new file mode 100644
index 0000000..de0ecd7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bip_prim_func2_pkg.ads
@@ -0,0 +1,17 @@
+generic
+   type First(<>) is abstract tagged limited private;
+   type Second(<>) is new First with private;
+   with function Make return Second is <>;
+package BIP_Prim_Func2_Pkg is
+
+   function Make (Key : Integer) return First'Class;
+
+private
+
+   type Some_Access is not null access function return First'Class;
+
+   function Make_Delegate return First'Class;
+
+   Thing_Access : constant Some_Access := Make_Delegate'Access;
+
+end BIP_Prim_Func2_Pkg;