2010-10-19 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 165680


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@165681 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 27 insertions, 1 deletions

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 91e984386f2..5bbcab0134c 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3846,6 +3846,28 @@ package body Freeze is
 
          elsif Is_Access_Type (E) then
 
+            --  If a pragma Default_Storage_Pool applies, and this type has no
+            --  Storage_Pool or Storage_Size clause (which must have occurred
+            --  before the freezing point), then use the default. This applies
+            --  only to base types.
+
+            if Present (Default_Pool)
+              and then E = Base_Type (E)
+              and then not Has_Storage_Size_Clause (E)
+              and then No (Associated_Storage_Pool (E))
+            then
+               --  Case of pragma Default_Storage_Pool (null)
+
+               if Nkind (Default_Pool) = N_Null then
+                  Set_No_Pool_Assigned (E);
+
+               --  Case of pragma Default_Storage_Pool (storage_pool_NAME)
+
+               else
+                  Set_Associated_Storage_Pool (E, Entity (Default_Pool));
+               end if;
+            end if;
+
             --  Check restriction for standard storage pool
 
             if No (Associated_Storage_Pool (E)) then
@@ -4570,8 +4592,12 @@ package body Freeze is
             --  The current scope may be that of a constrained component of
             --  an enclosing record declaration, which is above the current
             --  scope in the scope stack.
+            --  If the expression is within a top-level pragma, as for a pre-
+            --  condition on a library-level subprogram, nothing to do.
 
-            if Is_Record_Type (Scope (Current_Scope)) then
+            if not Is_Compilation_Unit (Current_Scope)
+              and then Is_Record_Type (Scope (Current_Scope))
+            then
                Pos := Pos - 1;
             end if;