diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-02-08 09:27:17 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-02-08 09:27:17 +0000 |
commit | b55f7641b510c7fd06a7ff9dbb8c173a412f9d43 (patch) | |
tree | dc8537cde3046210d1bdc3d08b0d20cde3b64224 /gcc/ada/exp_intr.adb | |
parent | cff7d88e0f1e1289cbe11cbffe0b1372fed55389 (diff) | |
download | gcc-b55f7641b510c7fd06a7ff9dbb8c173a412f9d43.tar.gz |
2012-02-08 Robert Dewar <dewar@adacore.com>
* a-coinve.adb, sem_util.adb, sem_ch8.adb, a-cobove.adb,
a-convec.adb: Minor reformatting and code reorganization.
2012-02-08 Steve Baird <baird@adacore.com>
* sem_cat.adb (In_Preelaborated_Unit): A child
unit instantiation does not inherit preelaboration requirements
from its parent.
2012-02-08 Gary Dismukes <dismukes@adacore.com>
* aspects.ads (type Aspect_Id): Add Aspect_Simple_Storage_Pool.
(Impl_Defined_Aspects): Add entry for Aspect_Simple_Storage_Pool.
(Aspect_Argument): Add Name entry for Aspect_Simple_Storage_Pool.
(Aspect_Names): Add entry for Aspect_Simple_Storage_Pool.
* aspects.adb (Canonical_Aspect): Add entry for
Aspect_Simple_Storage_Pool.
* exp_attr.adb (Expand_N_Attribute_Reference): Handle case of
Attribute_Simple_Storage_Pool in the same way as Storage_Pool
(add conversion, analyze/resolve). For the Storage_Size attribute,
for the simple pool case, locate and use the simple pool type's
Storage_Size function (if any), otherwise evaluate to zero.
* exp_ch4.adb (Expand_N_Allocator): In the case of an allocator
for an access type with an associated simple storage pool,
locate and use the pool type's Allocate.
* exp_intr.adb (Expand_Unc_Deallocation): In the case where the
access type has a simple storage pool, locate the pool type's
Deallocate procedure (if present) and use it as the procedure
to call on the Free operation.
* freeze.adb (Freeze_Entity): In the case of a full type for
a private type defined with pragma Simple_Storage_Pool, check
that the full type is also appropriate for the pragma. For
a simple storage pool type, validate that the operations
Allocate, Deallocate (if present), and Storage_Size
(if present) are defined with appropriate expected profiles.
(Validate_Simple_Pool_Op_Formal): New procedure
(Validate_Simple_Pool_Operation): New procedure Add with and
use of Rtsfind.
* par-prag.adb: Add Pragma_Simple_Storage_Pool to case statement
(no action required).
* sem_attr.adb (Analyze_Attribute): For the case of the
Storage_Pool attribute, give a warning if the prefix type has an
associated simple storage pool, and rewrite the attribute as a
raise of Program_Error. In the case of the Simple_Storage_Pool
attribute, check that the prefix type has an associated simple
storage pool, and set the attribute type to the pool's type.
* sem_ch13.adb (Analyze_Aspect_Specifications): Add
Aspect_Simple_Storage_Pool case choice.
(Analyze_Attribute_Definition_Clause): Add
Aspect_Simple_Storage_Pool to case for Ignore_Rep_Clauses
(no action). Add handling for Simple_Storage_Pool attribute
definition, requiring the name to denote a simple storage pool
object.
(Check_Aspect_At_Freeze_Point): For a simple storage pool
aspect, set the type to that of the name specified for the aspect.
* sem_prag.adb (Analyze_Pragma): Add handling for pragma
Simple_Storage_Pool, requiring that it applies to a library-level
type declared in a package declaration that is a limited private
or limited record type.
* sem_res.adb (Resolve_Allocator): Flag an attempt to call a
build-in-place function in an allocator for an access type with
a simple storage pool as unsupported.
* snames.ads-tmpl: Add Name_Simple_Storage_Pool.
(type Attribute_Id): Add Attribute_Simple_Storage_Pool.
(type Pragma_Id): Add Pragma_Simple_Storage_Pool.
* snames.adb-tmpl (Get_Pragma_Id): Handle case of
Name_Simple_Storage_Pool.
(Is_Pragma_Name): Return True for Name_Simple_Storage_Pool.
2012-02-08 Cyrille Comar <comar@adacore.com>
* projects.texi: Clarify doc for interfaces.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183997 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/exp_intr.adb')
-rw-r--r-- | gcc/ada/exp_intr.adb | 30 |
1 files changed, 29 insertions, 1 deletions
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index b116a8a28f0..2707d7a2a06 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -1084,6 +1084,34 @@ package body Exp_Intr is if Is_RTE (Pool, RE_SS_Pool) then null; + -- If the pool object is of a simple storage pool type, then attempt + -- to locate the type's Deallocate procedure, if any, and set the + -- free operation's procedure to call. If the type doesn't have a + -- Deallocate (which is allowed), then the actual will simply be set + -- to null. + + elsif Present (Get_Rep_Pragma + (Etype (Pool), Name_Simple_Storage_Pool)) + then + declare + Dealloc_Op : Entity_Id := Get_Name_Entity_Id (Name_Deallocate); + Pool_Type : constant Entity_Id := Base_Type (Etype (Pool)); + + begin + while Present (Dealloc_Op) loop + if Scope (Dealloc_Op) = Scope (Pool_Type) + and then Present (First_Formal (Dealloc_Op)) + and then Etype (First_Formal (Dealloc_Op)) = Pool_Type + then + Set_Procedure_To_Call (Free_Node, Dealloc_Op); + + exit; + end if; + + Dealloc_Op := Homonym (Dealloc_Op); + end loop; + end; + -- Case of a class-wide pool type: make a dispatching call to -- Deallocate through the class-wide Deallocate_Any. |