From c159409f3a8d7e53a499187ba7a2fc3aa2da3d04 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 11 Oct 2010 12:43:04 +0200 Subject: [multiple changes] 2010-10-11 Robert Dewar * 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 * 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 * 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 From-SVN: r165300 --- gcc/ada/sinfo.adb | 76 ++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 56 insertions(+), 20 deletions(-) (limited to 'gcc/ada/sinfo.adb') diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 3a5ffc2..5a14484 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -32,8 +32,7 @@ pragma Style_Checks (All_Checks); -- No subprogram ordering check, due to logical grouping -with Aspects; use Aspects; -with Atree; use Atree; +with Atree; use Atree; package body Sinfo is @@ -264,6 +263,14 @@ package body Sinfo is return Flag11 (N); end Aspect_Cancel; + function Aspect_Rep_Item + (N : Node_Id) return Node_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification); + return Node2 (N); + end Aspect_Rep_Item; + function Assignment_OK (N : Node_Id) return Boolean is begin @@ -1048,8 +1055,9 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind in N_Has_Entity - or else NT (N).Nkind = N_Freeze_Entity - or else NT (N).Nkind = N_Attribute_Definition_Clause); + or else NT (N).Nkind = N_Aspect_Specification + or else NT (N).Nkind = N_Attribute_Definition_Clause + or else NT (N).Nkind = N_Freeze_Entity); return Node4 (N); end Entity; @@ -1400,13 +1408,6 @@ package body Sinfo is return Node2 (N); end Handler_List_Entry; - function Has_Aspect_Specifications - (N : Node_Id) return Boolean is - begin - pragma Assert (Permits_Aspect_Specifications (N)); - return Flag3 (N); - end Has_Aspect_Specifications; - function Has_Created_Identifier (N : Node_Id) return Boolean is begin @@ -1690,6 +1691,15 @@ package body Sinfo is return Flag16 (N); end Is_Controlling_Actual; + function Is_Delayed_Aspect + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Attribute_Definition_Clause + or else NT (N).Nkind = N_Pragma); + return Flag14 (N); + end Is_Delayed_Aspect; + function Is_Dynamic_Coextension (N : Node_Id) return Boolean is begin @@ -2116,6 +2126,7 @@ package body Sinfo is (N : Node_Id) return Node_Id is begin pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification or else NT (N).Nkind = N_Attribute_Definition_Clause or else NT (N).Nkind = N_Enumeration_Representation_Clause or else NT (N).Nkind = N_Pragma @@ -3212,6 +3223,14 @@ package body Sinfo is Set_Flag11 (N, Val); end Set_Aspect_Cancel; + procedure Set_Aspect_Rep_Item + (N : Node_Id; Val : Node_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification); + Set_Node2 (N, Val); + end Set_Aspect_Rep_Item; + procedure Set_Assignment_OK (N : Node_Id; Val : Boolean := True) is begin @@ -3996,8 +4015,9 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind in N_Has_Entity - or else NT (N).Nkind = N_Freeze_Entity - or else NT (N).Nkind = N_Attribute_Definition_Clause); + or else NT (N).Nkind = N_Aspect_Specification + or else NT (N).Nkind = N_Attribute_Definition_Clause + or else NT (N).Nkind = N_Freeze_Entity); Set_Node4 (N, Val); -- semantic field, no parent set end Set_Entity; @@ -4339,13 +4359,6 @@ package body Sinfo is Set_Node2 (N, Val); end Set_Handler_List_Entry; - procedure Set_Has_Aspect_Specifications - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (Permits_Aspect_Specifications (N)); - Set_Flag3 (N, Val); - end Set_Has_Aspect_Specifications; - procedure Set_Has_Created_Identifier (N : Node_Id; Val : Boolean := True) is begin @@ -4630,6 +4643,15 @@ package body Sinfo is Set_Flag16 (N, Val); end Set_Is_Controlling_Actual; + procedure Set_Is_Delayed_Aspect + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Attribute_Definition_Clause + or else NT (N).Nkind = N_Pragma); + Set_Flag14 (N, Val); + end Set_Is_Delayed_Aspect; + procedure Set_Is_Dynamic_Coextension (N : Node_Id; Val : Boolean := True) is begin @@ -5056,6 +5078,7 @@ package body Sinfo is (N : Node_Id; Val : Node_Id) is begin pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification or else NT (N).Nkind = N_Attribute_Definition_Clause or else NT (N).Nkind = N_Enumeration_Representation_Clause or else NT (N).Nkind = N_Pragma @@ -5980,6 +6003,19 @@ package body Sinfo is end if; end End_Location; + -------------------- + -- Get_Pragma_Arg -- + -------------------- + + function Get_Pragma_Arg (Arg : Node_Id) return Node_Id is + begin + if Nkind (Arg) = N_Pragma_Argument_Association then + return Expression (Arg); + else + return Arg; + end if; + end Get_Pragma_Arg; + ---------------------- -- Set_End_Location -- ---------------------- -- cgit v1.1