[Ada] No_Allocators should suppress heap allocation in build-in-place returns

[Arnaud Charlet]

Tested on i686-linux, committed on trunk

When the restriction No_Allocators is active, the compiler no longer
generates a heap allocator as part of the expansion of return statements
within limited functions with unconstrained results, since those are
only needed to perform allocation on behalf of an allocator written by
the user. As a related change, No_Allocators is now only checked for
explicit allocators (those marked as Comes_From_Source), in conformance
with Ada RM H.4(7), preventing the issuing of errors on cases such as the
secondary-stack allocator generated for limited unconstrained function
returns.

gnat.dg/test_bip_no_alloc.adb must now compile quietly.

2008-03-26  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch5.adb (Expand_N_Extended_Return_Statement): Suppress generation
	of a heap allocator for a limited unconstrained function return when
	resstriction No_Allocators is active.
	(Analyze_Allocator): The restriction No_Allocators is now only checked
	on allocators that have Comes_From_Source set, as per RM-H.4(7).

	* sem_ch4.adb (Expand_N_Extended_Return_Statement): Suppress generation
	of a heap allocator for a limited unconstrained function return when
	resstriction No_Allocators is active.
	(Analyze_Allocator): The restriction No_Allocators is now only checked
	on allocators that have Comes_From_Source set, as per RM-H.4(7).
	(Has_Fixed_Op):  If the name in a function call is Standard."*" and the
	operands are fixed-point types, the universal_fixed predefined operation
	is used, regardless of whether the operand type (s) have a primitive
	operation of the same name.

-------------- next part --------------
Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb	(revision 133430)
+++ exp_ch5.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -2792,6 +2792,30 @@ package body Exp_Ch5 is
                         SS_Allocator := New_Copy_Tree (Heap_Allocator);
                      end if;
 
+                     --  If the No_Allocators restriction is active, then only
+                     --  an allocator for secondary stack allocation is needed.
+
+                     if Restriction_Active (No_Allocators) then
+                        SS_Allocator   := Heap_Allocator;
+                        Heap_Allocator := Make_Null (Loc);
+
+                     --  Otherwise the heap allocator may be needed, so we
+                     --  make another allocator for secondary stack allocation.
+
+                     else
+                        SS_Allocator := New_Copy_Tree (Heap_Allocator);
+
+                        --  The heap allocator is marked Comes_From_Source
+                        --  since it corresponds to an explicit user-written
+                        --  allocator (that is, it will only be executed on
+                        --  behalf of callers that call the function as
+                        --  initialization for such an allocator). This
+                        --  prevents errors when No_Implicit_Heap_Allocation
+                        --  is in force.
+
+                        Set_Comes_From_Source (Heap_Allocator, True);
+                     end if;
+
                      --  The allocator is returned on the secondary stack. We
                      --  don't do this on VM targets, since the SS is not used.
 
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb	(revision 133430)
+++ sem_ch4.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -356,7 +356,12 @@ package body Sem_Ch4 is
       Type_Id  : Entity_Id;
 
    begin
-      Check_Restriction (No_Allocators, N);
+      --  In accordance with H.4(7), the No_Allocators restriction only applies
+      --  to user-written allocators.
+
+      if Comes_From_Source (N) then
+         Check_Restriction (No_Allocators, N);
+      end if;
 
       if Nkind (E) = N_Qualified_Expression then
          Acc_Type := Create_Itype (E_Allocator_Type, N);
@@ -3811,6 +3816,10 @@ package body Sem_Ch4 is
       --  predefined operator. Used to implement Ada 2005 AI-264, to make
       --  such operators more visible and therefore useful.
 
+      --  If the name of the operation is an expanded name with prefix
+      --  Standard, the predefined universal fixed operator is available,
+      --  as specified by AI-420 (RM 4.5.5 (19.1/2)).
+
       function Specific_Type (T1, T2 : Entity_Id) return Entity_Id;
       --  Get specific type (i.e. non-universal type if there is one)
 
@@ -3825,6 +3834,16 @@ package body Sem_Ch4 is
          F2  : Entity_Id;
 
       begin
+         --  If the universal_fixed operation is given explicitly the rule
+         --  concerning primitive operations of the type do not apply.
+
+         if Nkind (N) = N_Function_Call
+           and then Nkind (Name (N)) = N_Expanded_Name
+           and then Entity (Prefix (Name (N))) = Standard_Standard
+         then
+            return False;
+         end if;
+
          --  The operation is treated as primitive if it is declared in the
          --  same scope as the type, and therefore on the same entity chain.