2010-10-11 Robert Dewar <dewar@adacore.com>

	* g-htable.ads (Get_First): New procedural version for Simple_HTable
	(Get_Next): New procedural version for Simple_HTable
	* s-htable.adb (Get_First): New procedural version for Simple_HTable
	(Get_Next): New procedural version for Simple_HTable
	* s-htable.ads (Get_First): New procedural version for Simple_HTable
	(Get_Next): New procedural version for Simple_HTable

2010-10-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Propagate_Discriminants): To gather the components of a
	variant part, use the association list of the subaggregate, which
	already includes the values of the needed discriminants.

2010-10-11  Robert Dewar  <dewar@adacore.com>

	* aspects.ads, aspects.adb: Changes to accomodate aspect delay
	(Tree_Write): New procedure.
	* atree.ads, atree.adb: Flag3 is now Has_Aspects and applies to all
	nodes.
	* atree.h: Flag3 is now Has_Aspects and applies to all nodes
	* debug.adb: Add debug flag gnatd.A
	* einfo.adb (Has_Delayed_Aspects): New flag
	(Get_Rep_Item_For_Entity): New function
	* einfo.ads (Has_Delayed_Aspects): New flag
	(Get_Rep_Item_For_Entity): New function
	* exp_ch13.adb (Expand_N_Freeze_Entity): Insert delayed aspects into
	tree.
	* exp_ch3.adb, exp_ch6.adb, exp_ch9.adb, exp_disp.adb: New calling
	sequence for Freeze_Entity.
	* freeze.ads, freeze.adb (Freeze_Entity): Takes node rather than source
	ptr. All calls are changed to this new interface.
	(Freeze_And_Append): Same change
	(Freeze_Entity): Evaluate deferred aspects
	* sem_attr.adb: New calling sequence for Freeze_Entity
	(Eval_Attribute): Don't try to evaluate attributes of unfrozen types
	when we are in spec expression preanalysis mode.
	* sem_ch10.adb: New calling sequence for Freeze_Entity
	* sem_ch11.adb: Simplify analysis of aspect specifications now that the
	flag Has_Aspects applies to all nodes (no need to save aspects).
	* sem_ch12.adb: Simplify analysis of aspect specifications now that the
	flag Has_Aspects applies to all nodes (no need to save aspects).
	* sem_ch13.adb (Analyze_Aspect_Specifications): Major rewrite to
	accomodate delaying aspect evaluation to the freeze point.
	(Duplicate_Clause): Simplify using Get_Rep_Item_For_Entity, and also
	accomodate delayed aspects.
	(Rep_Item_Too_Late): Deal with delayed aspects case
	* sem_ch13.ads (Rep_Item_Too_Late): Document handling of delayed aspects
	* sem_ch3.adb (Analyze_Subtype_Declaration): Make sure that generic
	actual types are properly frozen (this is needed because of the new
	check in Eval_Attribute that declines to evaluate attributes
	for unfrozen types).
	Simplify analysis of aspect specifications now that the flag
	Has_Aspects applies to all nodes (no need to save aspects).
	* sem_ch3.ads (Preanalyze_Spec_Expression): Note use for delayed aspects
	* sem_ch5.adb: Simplify analysis of aspect specifications now that the
	flag Has_Aspects applies to all nodes (no need to save aspects).
	New calling sequence for Freeze_Entity.
	* sem_ch9.adb, sem_ch7.adb, sem_ch6.adb: Simplify analysis of aspect
	specifications now that the flag Has_Aspects applies to all nodes
	(no need to save aspects).
	New calling sequence for Freeze_Entity
	* sem_prag.adb (Check_Duplicate_Pragma): Simplify using
	Get_Rep_Item_For_Entity
	(Get_Pragma_Arg): Moved to Sinfo
	* sinfo.ads, sinfo.adb (Aspect_Rep_Item_: New field
	(Is_Delayed_Aspect): New flag
	(Next_Rep_Item): Document use for aspects
	(Get_Pragma_Arg): Moved here from Sem_Prag
	* sprint.adb (Sprint_Aspect_Specifications): Now called after semicolon
	is output and removes semicolon (simplifies interface).
	(Sprint_Node_Actual): Simplify handling of aspects now that Has_Aspects
	applies to any node.
	* tree_gen.adb: Write contents of Aspect_Specifications hash table
	* tree_in.adb: Read and initialize Aspect_Specifications hash table
	* treepr.adb (Print_Node): Print Has_Aspects flag
	(Print_Node): Print Aspect_Specifications in Has_Aspects set
	* xtreeprs.adb: Remove obsolete references to Flag1,2,3



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

1 files changed, 52 insertions, 29 deletions

diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 47ca88ef980..2a54d63e7ec 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -36,6 +36,7 @@ pragma Style_Checks (All_Checks);
 --  file must be properly reflected in the file atree.h which is a C header
 --  file containing equivalent definitions for use by gigi.
 
+with Aspects; use Aspects;
 with Debug;   use Debug;
 with Nlists;  use Nlists;
 with Output;  use Output;
@@ -1087,6 +1088,16 @@ package body Atree is
       return Default_Node.Comes_From_Source;
    end Get_Comes_From_Source_Default;
 
+   -----------------
+   -- Has_Aspects --
+   -----------------
+
+   function Has_Aspects (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (N <= Nodes.Last);
+      return Nodes.Table (N).Has_Aspects;
+   end Has_Aspects;
+
    -------------------
    -- Has_Extension --
    -------------------
@@ -1563,20 +1574,22 @@ package body Atree is
    -------------
 
    procedure Replace (Old_Node, New_Node : Node_Id) is
-      Old_Post : constant Boolean  := Nodes.Table (Old_Node).Error_Posted;
-      Old_CFS  : constant Boolean  := Nodes.Table (Old_Node).Comes_From_Source;
+      Old_Post : constant Boolean := Nodes.Table (Old_Node).Error_Posted;
+      Old_HasA : constant Boolean := Nodes.Table (Old_Node).Has_Aspects;
+      Old_CFS  : constant Boolean := Nodes.Table (Old_Node).Comes_From_Source;
 
    begin
       pragma Assert
         (not Has_Extension (Old_Node)
-           and not Has_Extension (New_Node)
-           and not Nodes.Table (New_Node).In_List);
+          and not Has_Extension (New_Node)
+          and not Nodes.Table (New_Node).In_List);
 
-      --  Do copy, preserving link and in list status and comes from source
+      --  Do copy, preserving link and in list status and required flags
 
       Copy_Node (Source => New_Node, Destination => Old_Node);
       Nodes.Table (Old_Node).Comes_From_Source := Old_CFS;
       Nodes.Table (Old_Node).Error_Posted      := Old_Post;
+      Nodes.Table (Old_Node).Has_Aspects       := Old_HasA;
 
       --  Fix parents of substituted node, since it has changed identity
 
@@ -1601,7 +1614,10 @@ package body Atree is
 
    procedure Rewrite (Old_Node, New_Node : Node_Id) is
       Old_Error_P : constant Boolean  := Nodes.Table (Old_Node).Error_Posted;
-      --  This fields is always preserved in the new node
+      --  This field is always preserved in the new node
+
+      Old_Has_Aspects : constant Boolean := Nodes.Table (Old_Node).Has_Aspects;
+      --  This field is always preserved in the new node
 
       Old_Paren_Count     : Nat;
       Old_Must_Not_Freeze : Boolean;
@@ -1616,15 +1632,15 @@ package body Atree is
    begin
       pragma Assert
         (not Has_Extension (Old_Node)
-           and not Has_Extension (New_Node)
-           and not Nodes.Table (New_Node).In_List);
+          and not Has_Extension (New_Node)
+          and not Nodes.Table (New_Node).In_List);
       pragma Debug (Rewrite_Debugging_Output (Old_Node, New_Node));
 
       if Nkind (Old_Node) in N_Subexpr then
          Old_Paren_Count     := Paren_Count (Old_Node);
          Old_Must_Not_Freeze := Must_Not_Freeze (Old_Node);
       else
-         Old_Paren_Count := 0;
+         Old_Paren_Count     := 0;
          Old_Must_Not_Freeze := False;
       end if;
 
@@ -1638,12 +1654,21 @@ package body Atree is
          Sav_Node := New_Copy (Old_Node);
          Orig_Nodes.Table (Sav_Node) := Sav_Node;
          Orig_Nodes.Table (Old_Node) := Sav_Node;
+
+         --  Both the old and new copies of the node will share the same list
+         --  of aspect specifications if aspect specifications are present.
+
+         if Has_Aspects (Sav_Node) then
+            Set_Aspect_Specifications
+              (Sav_Node, Aspect_Specifications (Old_Node));
+         end if;
       end if;
 
       --  Copy substitute node into place, preserving old fields as required
 
       Copy_Node (Source => New_Node, Destination => Old_Node);
       Nodes.Table (Old_Node).Error_Posted := Old_Error_P;
+      Nodes.Table (Old_Node).Has_Aspects  := Old_Has_Aspects;
 
       if Nkind (New_Node) in N_Subexpr then
          Set_Paren_Count     (Old_Node, Old_Paren_Count);
@@ -1737,6 +1762,16 @@ package body Atree is
    end Set_Error_Posted;
 
    ---------------------
+   -- Set_Has_Aspects --
+   ---------------------
+
+   procedure Set_Has_Aspects (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (N <= Nodes.Last);
+      Nodes.Table (N).Has_Aspects := Val;
+   end Set_Has_Aspects;
+
+   ---------------------
    -- Set_Paren_Count --
    ---------------------
 
@@ -2704,12 +2739,6 @@ package body Atree is
          return From_Union (Nodes.Table (N + 3).Field8);
       end Ureal21;
 
-      function Flag3 (N : Node_Id) return Boolean is
-      begin
-         pragma Assert (N <= Nodes.Last);
-         return Nodes.Table (N).Flag3;
-      end Flag3;
-
       function Flag4 (N : Node_Id) return Boolean is
       begin
          pragma Assert (N <= Nodes.Last);
@@ -2809,7 +2838,7 @@ package body Atree is
       function Flag20 (N : Node_Id) return Boolean is
       begin
          pragma Assert (Nkind (N) in N_Entity);
-         return Nodes.Table (N + 1).Flag3;
+         return Nodes.Table (N + 1).Has_Aspects;
       end Flag20;
 
       function Flag21 (N : Node_Id) return Boolean is
@@ -2935,7 +2964,7 @@ package body Atree is
       function Flag41 (N : Node_Id) return Boolean is
       begin
          pragma Assert (Nkind (N) in N_Entity);
-         return Nodes.Table (N + 2).Flag3;
+         return Nodes.Table (N + 2).Has_Aspects;
       end Flag41;
 
       function Flag42 (N : Node_Id) return Boolean is
@@ -3469,7 +3498,7 @@ package body Atree is
       function Flag130 (N : Node_Id) return Boolean is
       begin
          pragma Assert (Nkind (N) in N_Entity);
-         return Nodes.Table (N + 3).Flag3;
+         return Nodes.Table (N + 3).Has_Aspects;
       end Flag130;
 
       function Flag131 (N : Node_Id) return Boolean is
@@ -3991,7 +4020,7 @@ package body Atree is
       function Flag217 (N : Node_Id) return Boolean is
       begin
          pragma Assert (Nkind (N) in N_Entity);
-         return Nodes.Table (N + 4).Flag3;
+         return Nodes.Table (N + 4).Has_Aspects;
       end Flag217;
 
       function Flag218 (N : Node_Id) return Boolean is
@@ -4812,12 +4841,6 @@ package body Atree is
          Nodes.Table (N + 3).Field8 := To_Union (Val);
       end Set_Ureal21;
 
-      procedure Set_Flag3 (N : Node_Id; Val : Boolean) is
-      begin
-         pragma Assert (N <= Nodes.Last);
-         Nodes.Table (N).Flag3 := Val;
-      end Set_Flag3;
-
       procedure Set_Flag4 (N : Node_Id; Val : Boolean) is
       begin
          pragma Assert (N <= Nodes.Last);
@@ -4917,7 +4940,7 @@ package body Atree is
       procedure Set_Flag20 (N : Node_Id; Val : Boolean) is
       begin
          pragma Assert (Nkind (N) in N_Entity);
-         Nodes.Table (N + 1).Flag3 := Val;
+         Nodes.Table (N + 1).Has_Aspects := Val;
       end Set_Flag20;
 
       procedure Set_Flag21 (N : Node_Id; Val : Boolean) is
@@ -5043,7 +5066,7 @@ package body Atree is
       procedure Set_Flag41 (N : Node_Id; Val : Boolean) is
       begin
          pragma Assert (Nkind (N) in N_Entity);
-         Nodes.Table (N + 2).Flag3 := Val;
+         Nodes.Table (N + 2).Has_Aspects := Val;
       end Set_Flag41;
 
       procedure Set_Flag42 (N : Node_Id; Val : Boolean) is
@@ -5705,7 +5728,7 @@ package body Atree is
       procedure Set_Flag130 (N : Node_Id; Val : Boolean) is
       begin
          pragma Assert (Nkind (N) in N_Entity);
-         Nodes.Table (N + 3).Flag3 := Val;
+         Nodes.Table (N + 3).Has_Aspects := Val;
       end Set_Flag130;
 
       procedure Set_Flag131 (N : Node_Id; Val : Boolean) is
@@ -6355,7 +6378,7 @@ package body Atree is
       procedure Set_Flag217 (N : Node_Id; Val : Boolean) is
       begin
          pragma Assert (Nkind (N) in N_Entity);
-         Nodes.Table (N + 4).Flag3 := Val;
+         Nodes.Table (N + 4).Has_Aspects := Val;
       end Set_Flag217;
 
       procedure Set_Flag218 (N : Node_Id; Val : Boolean) is