-- --
-- 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- --
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.
-- --
-- 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- --
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);
-- 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)
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.