summaryrefslogtreecommitdiff
path: root/gcc/ada/exp_intr.adb
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2012-02-08 09:27:17 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2012-02-08 09:27:17 +0000
commitb55f7641b510c7fd06a7ff9dbb8c173a412f9d43 (patch)
treedc8537cde3046210d1bdc3d08b0d20cde3b64224 /gcc/ada/exp_intr.adb
parentcff7d88e0f1e1289cbe11cbffe0b1372fed55389 (diff)
downloadgcc-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.adb30
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.