diff mbox

[Ada] Aspect Default_Storage_Pool

Message ID 20141031110946.GA23907@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 31, 2014, 11:09 a.m. UTC 
This aspect was not properly recognized by GNAT, even though the corresponding
pragma was fully handled.

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-10-31  Ed Schonberg  <schonberg@adacore.com>

	* aspects.ads, aspects.adb: Add aspect Default_Storage_Pool.
	* sem_ch13.adb (Analyze_One_Aspect): Generate pragma for aspect
	Default_Storage_Pool.
diff mbox

Patch

Index: aspects.adb
===================================================================
--- aspects.adb	(revision 216925)
+++ aspects.adb	(working copy)
@@ -511,6 +511,7 @@ 
     Aspect_Default_Component_Value      => Aspect_Default_Component_Value,
     Aspect_Default_Initial_Condition    => Aspect_Default_Initial_Condition,
     Aspect_Default_Iterator             => Aspect_Default_Iterator,
+    Aspect_Default_Storage_Pool         => Aspect_Default_Storage_Pool,
     Aspect_Default_Value                => Aspect_Default_Value,
     Aspect_Depends                      => Aspect_Depends,
     Aspect_Dimension                    => Aspect_Dimension,
Index: aspects.ads
===================================================================
--- aspects.ads	(revision 216925)
+++ aspects.ads	(working copy)
@@ -88,6 +88,7 @@ 
       Aspect_Default_Component_Value,
       Aspect_Default_Initial_Condition,     -- GNAT
       Aspect_Default_Iterator,
+      Aspect_Default_Storage_Pool,
       Aspect_Default_Value,
       Aspect_Depends,                       -- GNAT
       Aspect_Dimension,                     -- GNAT
@@ -314,6 +315,7 @@ 
       Aspect_Default_Component_Value   => Expression,
       Aspect_Default_Initial_Condition => Optional_Expression,
       Aspect_Default_Iterator          => Name,
+      Aspect_Default_Storage_Pool      => Expression,
       Aspect_Default_Value             => Expression,
       Aspect_Depends                   => Expression,
       Aspect_Dimension                 => Expression,
@@ -401,6 +403,7 @@ 
       Aspect_Default_Component_Value      => Name_Default_Component_Value,
       Aspect_Default_Initial_Condition    => Name_Default_Initial_Condition,
       Aspect_Default_Iterator             => Name_Default_Iterator,
+      Aspect_Default_Storage_Pool         => Name_Default_Storage_Pool,
       Aspect_Default_Value                => Name_Default_Value,
       Aspect_Depends                      => Name_Depends,
       Aspect_Dimension                    => Name_Dimension,
@@ -616,6 +619,7 @@ 
       Aspect_Constant_Indexing            => Always_Delay,
       Aspect_CPU                          => Always_Delay,
       Aspect_Default_Iterator             => Always_Delay,
+      Aspect_Default_Storage_Pool         => Always_Delay,
       Aspect_Default_Value                => Always_Delay,
       Aspect_Default_Component_Value      => Always_Delay,
       Aspect_Discard_Names                => Always_Delay,
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 216925)
+++ sem_ch13.adb	(working copy)
@@ -2236,6 +2236,20 @@ 
                   Insert_Pragma (Aitem);
                   goto Continue;
 
+               --  Default_Storage_Pool
+
+               when Aspect_Default_Storage_Pool =>
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  =>
+                       Name_Default_Storage_Pool);
+
+                  Decorate (Aspect, Aitem);
+                  Insert_Pragma (Aitem);
+                  goto Continue;
+
                --  Depends
 
                --  Aspect Depends is never delayed because it is equivalent to
@@ -8693,6 +8707,9 @@ 
          when Aspect_Default_Component_Value =>
             T := Component_Type (Entity (ASN));
 
+         when Aspect_Default_Storage_Pool =>
+            T := Class_Wide_Type (RTE (RE_Root_Storage_Pool));
+
          --  Default_Value is resolved with the type entity in question
 
          when Aspect_Default_Value =>