2010-10-18 Bob Duff <duff@adacore.com>

	* sinfo.ads, sinfo.adb: Modify comment about adding fields to be more
	correct, and to be in a more convenient order.
	(Default_Storage_Pool): New field of N_Compilation_Unit_Aux, for
	recording the Default_Storage_Pool for a parent library unit.
	* einfo.ads (Etype): Document the case in which Etype can be Empty.
	* sem_prag.adb (Pragma_Default_Storage_Pool): Analyze the new
	Default_Storage_Pool pragma.
	* sem.ads (Save_Default_Storage_Pool): Save area for push/pop scopes.
	* gnat_ugn.texi: Document Default_Storage_Pool as a new configuration
	pragma.
	* freeze.adb (Freeze_Entity): When freezing an access type, take into
	account any Default_Storage_Pool pragma that applies. We have to do
	this at the freezing point, because up until that point, a Storage_Pool
	or Storage_Size clause could occur, which should override the
	Default_Storage_Pool.
	* par-prag.adb: Add this pragma to the list of pragmas handled entirely
	during semantics.
	* sem_ch8.adb (Push_Scope, Pop_Scope): Save and restore the
	Default_Storage_Pool information.
	* opt.ads (Default_Pool, Default_Pool_Config): New globals for recording
	currently-applicable Default_Storage_Pool pragmas.
	* opt.adb: Save/restore the globals as appropriate.
	* snames.ads-tmpl (Name_Default_Storage_Pool,
	Pragma_Default_Storage_Pool): New pragma name.

2010-10-18  Vincent Celier  <celier@adacore.com>

	* make.adb (Switches_Of): Put the spec and body suffix in canonical
	case.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165637 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 37 insertions, 4 deletions

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index e891e70ffdb..cdd8bf69eb0 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -6636,18 +6636,36 @@ package body Sem_Ch8 is
 
    procedure Pop_Scope is
       SST : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last);
+      S   : constant Entity_Id := SST.Entity;
 
    begin
       if Debug_Flag_E then
          Write_Info;
       end if;
 
+      --  Set Default_Storage_Pool field of the library unit if necessary
+
+      if Ekind_In (S, E_Package, E_Generic_Package)
+        and then
+          Nkind (Parent (Unit_Declaration_Node (S))) = N_Compilation_Unit
+      then
+         declare
+            Aux : constant Node_Id :=
+              Aux_Decls_Node (Parent (Unit_Declaration_Node (S)));
+         begin
+            if No (Default_Storage_Pool (Aux)) then
+               Set_Default_Storage_Pool (Aux, Default_Pool);
+            end if;
+         end;
+      end if;
+
       Scope_Suppress           := SST.Save_Scope_Suppress;
       Local_Suppress_Stack_Top := SST.Save_Local_Suppress_Stack_Top;
       Check_Policy_List        := SST.Save_Check_Policy_List;
+      Default_Pool             := SST.Save_Default_Storage_Pool;
 
       if Debug_Flag_W then
-         Write_Str ("--> exiting scope: ");
+         Write_Str ("<-- exiting scope: ");
          Write_Name (Chars (Current_Scope));
          Write_Str (", Depth=");
          Write_Int (Int (Scope_Stack.Last));
@@ -6679,7 +6697,7 @@ package body Sem_Ch8 is
    ---------------
 
    procedure Push_Scope (S : Entity_Id) is
-      E : Entity_Id;
+      E : constant Entity_Id := Scope (S);
 
    begin
       if Ekind (S) = E_Void then
@@ -6717,6 +6735,7 @@ package body Sem_Ch8 is
          SST.Save_Scope_Suppress           := Scope_Suppress;
          SST.Save_Local_Suppress_Stack_Top := Local_Suppress_Stack_Top;
          SST.Save_Check_Policy_List        := Check_Policy_List;
+         SST.Save_Default_Storage_Pool     := Default_Pool;
 
          if Scope_Stack.Last > Scope_Stack.First then
             SST.Component_Alignment_Default := Scope_Stack.Table
@@ -6753,8 +6772,6 @@ package body Sem_Ch8 is
         and then Scope (S) /= Standard_Standard
         and then not Is_Child_Unit (S)
       then
-         E := Scope (S);
-
          if Nkind (E) not in N_Entity then
             return;
          end if;
@@ -6776,6 +6793,22 @@ package body Sem_Ch8 is
             Set_Categorization_From_Scope (E => S, Scop => E);
          end if;
       end if;
+
+      if Is_Child_Unit (S)
+        and then Present (E)
+        and then Ekind_In (E, E_Package, E_Generic_Package)
+        and then
+          Nkind (Parent (Unit_Declaration_Node (E))) = N_Compilation_Unit
+      then
+         declare
+            Aux : constant Node_Id :=
+              Aux_Decls_Node (Parent (Unit_Declaration_Node (E)));
+         begin
+            if Present (Default_Storage_Pool (Aux)) then
+               Default_Pool := Default_Storage_Pool (Aux);
+            end if;
+         end;
+      end if;
    end Push_Scope;
 
    ---------------------