sem_res.adb (Resolve_Allocator): Warning on allocation of tasks on a subpool and rewrite the allocator into a...
2011-12-20 Hristian Kirtchev <kirtchev@adacore.com> * sem_res.adb (Resolve_Allocator): Warning on allocation of tasks on a subpool and rewrite the allocator into a raise Program_Error statement. * s-stposu.ads, s-stposu.adb: Code reformatting. (Create_Subpool): Remove formal parameter Storage_Size. (Default_Subpool_For_Pool): Add the default implementation of this routine. (Set_Pool_Of_Subpool): Rename formal parameter Pool to To. Update all the uses of the parameter. From-SVN: r182533
This commit is contained in:
parent
9a417f117e
commit
7b2aafc959
|
@ -1,3 +1,15 @@
|
|||
2011-12-20 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_res.adb (Resolve_Allocator): Warning on allocation
|
||||
of tasks on a subpool and rewrite the allocator into a raise
|
||||
Program_Error statement.
|
||||
* s-stposu.ads, s-stposu.adb: Code reformatting.
|
||||
(Create_Subpool): Remove formal parameter Storage_Size.
|
||||
(Default_Subpool_For_Pool): Add the default implementation of this
|
||||
routine.
|
||||
(Set_Pool_Of_Subpool): Rename formal parameter Pool to To. Update
|
||||
all the uses of the parameter.
|
||||
|
||||
2011-12-20 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
|
||||
|
||||
* gcc-interface/Makefile.in (%86 linux%):
|
||||
|
|
|
@ -431,6 +431,19 @@ package body System.Storage_Pools.Subpools is
|
|||
Deallocate (Pool, N_Addr, N_Size, Alignment);
|
||||
end Deallocate_Any_Controlled;
|
||||
|
||||
------------------------------
|
||||
-- Default_Subpool_For_Pool --
|
||||
------------------------------
|
||||
|
||||
function Default_Subpool_For_Pool
|
||||
(Pool : Root_Storage_Pool_With_Subpools) return not null Subpool_Handle
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
|
||||
return Pool.Subpools.Subpool;
|
||||
end Default_Subpool_For_Pool;
|
||||
|
||||
------------
|
||||
-- Detach --
|
||||
------------
|
||||
|
@ -607,7 +620,8 @@ package body System.Storage_Pools.Subpools is
|
|||
---------------------
|
||||
|
||||
function Pool_Of_Subpool (Subpool : not null Subpool_Handle)
|
||||
return access Root_Storage_Pool_With_Subpools'Class is
|
||||
return access Root_Storage_Pool_With_Subpools'Class
|
||||
is
|
||||
begin
|
||||
return Subpool.Owner;
|
||||
end Pool_Of_Subpool;
|
||||
|
@ -762,7 +776,7 @@ package body System.Storage_Pools.Subpools is
|
|||
|
||||
procedure Set_Pool_Of_Subpool
|
||||
(Subpool : not null Subpool_Handle;
|
||||
Pool : in out Root_Storage_Pool_With_Subpools'Class)
|
||||
To : in out Root_Storage_Pool_With_Subpools'Class)
|
||||
is
|
||||
N_Ptr : SP_Node_Ptr;
|
||||
|
||||
|
@ -777,12 +791,12 @@ package body System.Storage_Pools.Subpools is
|
|||
-- Prevent the creation of a new subpool while the owner is being
|
||||
-- finalized. This is a serious error.
|
||||
|
||||
if Pool.Finalization_Started then
|
||||
if To.Finalization_Started then
|
||||
raise Program_Error
|
||||
with "subpool creation after finalization started";
|
||||
end if;
|
||||
|
||||
Subpool.Owner := Pool'Unchecked_Access;
|
||||
Subpool.Owner := To'Unchecked_Access;
|
||||
|
||||
-- Create a subpool node and decorate it. Since this node is not
|
||||
-- allocated on the owner's pool, it must be explicitly destroyed by
|
||||
|
@ -792,7 +806,7 @@ package body System.Storage_Pools.Subpools is
|
|||
N_Ptr.Subpool := Subpool;
|
||||
Subpool.Node := N_Ptr;
|
||||
|
||||
Attach (N_Ptr, Pool.Subpools'Unchecked_Access);
|
||||
Attach (N_Ptr, To.Subpools'Unchecked_Access);
|
||||
|
||||
-- Mark the subpool's master as being a heterogeneous collection of
|
||||
-- controlled objects.
|
||||
|
|
|
@ -38,7 +38,7 @@ with System.Finalization_Masters;
|
|||
with System.Storage_Elements;
|
||||
|
||||
package System.Storage_Pools.Subpools is
|
||||
pragma Preelaborate;
|
||||
pragma Preelaborate (Subpools);
|
||||
|
||||
type Root_Storage_Pool_With_Subpools is abstract
|
||||
new Root_Storage_Pool with private;
|
||||
|
@ -70,8 +70,7 @@ package System.Storage_Pools.Subpools is
|
|||
Storage_Address : out System.Address;
|
||||
Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
|
||||
Alignment : System.Storage_Elements.Storage_Count;
|
||||
Subpool : not null Subpool_Handle)
|
||||
is abstract;
|
||||
Subpool : not null Subpool_Handle) is abstract;
|
||||
|
||||
-- ??? This precondition causes errors in simple tests, disabled for now
|
||||
|
||||
|
@ -79,12 +78,8 @@ package System.Storage_Pools.Subpools is
|
|||
-- This routine requires implementation. Allocate an object described by
|
||||
-- Size_In_Storage_Elements and Alignment on a subpool.
|
||||
|
||||
function Create_Subpool
|
||||
(Pool : in out Root_Storage_Pool_With_Subpools;
|
||||
Storage_Size : Storage_Elements.Storage_Count :=
|
||||
Storage_Elements.Storage_Count'Last)
|
||||
return not null Subpool_Handle
|
||||
is abstract;
|
||||
function Create_Subpool (Pool : in out Root_Storage_Pool_With_Subpools)
|
||||
return not null Subpool_Handle is abstract;
|
||||
-- This routine requires implementation. Create a subpool within the given
|
||||
-- pool_with_subpools.
|
||||
|
||||
|
@ -97,8 +92,7 @@ package System.Storage_Pools.Subpools is
|
|||
|
||||
procedure Deallocate_Subpool
|
||||
(Pool : in out Root_Storage_Pool_With_Subpools;
|
||||
Subpool : in out Subpool_Handle)
|
||||
is abstract;
|
||||
Subpool : in out Subpool_Handle) is abstract;
|
||||
|
||||
-- ??? This precondition causes errors in simple tests, disabled for now
|
||||
|
||||
|
@ -108,24 +102,26 @@ package System.Storage_Pools.Subpools is
|
|||
-- Ada.Unchecked_Deallocate_Subpool.
|
||||
|
||||
function Default_Subpool_For_Pool
|
||||
(Pool : Root_Storage_Pool_With_Subpools)
|
||||
return not null Subpool_Handle
|
||||
is abstract;
|
||||
-- This routine requires implementation. Returns a common subpool used for
|
||||
-- allocations without Subpool_Handle_name in the allocator.
|
||||
(Pool : Root_Storage_Pool_With_Subpools) return not null Subpool_Handle;
|
||||
-- Return a common subpool which is used for object allocations without a
|
||||
-- Subpool_Handle_name in the allocator. The default implementation of this
|
||||
-- routine raises Program_Error.
|
||||
|
||||
function Pool_Of_Subpool
|
||||
(Subpool : not null Subpool_Handle)
|
||||
function Pool_Of_Subpool (Subpool : not null Subpool_Handle)
|
||||
return access Root_Storage_Pool_With_Subpools'Class;
|
||||
-- Return the owner of the subpool
|
||||
|
||||
procedure Set_Pool_Of_Subpool
|
||||
(Subpool : not null Subpool_Handle;
|
||||
Pool : in out Root_Storage_Pool_With_Subpools'Class);
|
||||
To : in out Root_Storage_Pool_With_Subpools'Class);
|
||||
-- Set the owner of the subpool. This is intended to be called from
|
||||
-- Create_Subpool or similar subpool constructors. Raises Program_Error
|
||||
-- if the subpool already belongs to a pool.
|
||||
|
||||
overriding function Storage_Size (Pool : Root_Storage_Pool_With_Subpools)
|
||||
return System.Storage_Elements.Storage_Count is
|
||||
(System.Storage_Elements.Storage_Count'Last);
|
||||
|
||||
private
|
||||
-- Model
|
||||
-- Pool_With_Subpools SP_Node SP_Node SP_Node
|
||||
|
|
|
@ -4469,23 +4469,26 @@ package body Sem_Res is
|
|||
and then Ekind (Current_Scope) = E_Package
|
||||
and then not In_Package_Body (Current_Scope)
|
||||
then
|
||||
Error_Msg_N ("cannot activate task before body seen?", N);
|
||||
Error_Msg_N ("\Program_Error will be raised at run time?", N);
|
||||
Error_Msg_N ("?cannot activate task before body seen", N);
|
||||
Error_Msg_N ("\?Program_Error will be raised at run time", N);
|
||||
end if;
|
||||
|
||||
-- Ada 2012 (AI05-0111-3): Issue a warning whenever allocating a task
|
||||
-- or a type containing tasks on a subpool since the deallocation of
|
||||
-- the subpool may lead to undefined task behavior. Perform the check
|
||||
-- only when the allocator has not been converted into a Program_Error
|
||||
-- due to a previous error.
|
||||
-- Ada 2012 (AI05-0111-3): Detect an attempt to allocate a task or a
|
||||
-- type with a task component on a subpool. This action must raise
|
||||
-- Program_Error at runtime.
|
||||
|
||||
if Ada_Version >= Ada_2012
|
||||
and then Nkind (N) = N_Allocator
|
||||
and then Present (Subpool_Handle_Name (N))
|
||||
and then Has_Task (Desig_T)
|
||||
then
|
||||
Error_Msg_N ("?allocation of task on subpool may lead to " &
|
||||
"undefined behavior", N);
|
||||
Error_Msg_N ("?cannot allocate task on subpool", N);
|
||||
Error_Msg_N ("\?Program_Error will be raised at run time", N);
|
||||
|
||||
Rewrite (N,
|
||||
Make_Raise_Program_Error (Sloc (N),
|
||||
Reason => PE_Explicit_Raise));
|
||||
Set_Etype (N, Typ);
|
||||
end if;
|
||||
end Resolve_Allocator;
|
||||
|
||||
|
|
Loading…
Reference in New Issue