Commit 50cff367 by Gary Dismukes Committed by Arnaud Charlet

exp_ch5.adb (Expand_N_Extended_Return_Statement): Suppress generation of a heap…

exp_ch5.adb (Expand_N_Extended_Return_Statement): Suppress generation of a heap allocator for a limited unconstrained function...

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.

From-SVN: r133563
parent 59ae6391
......@@ -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.
......
......@@ -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.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment