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/sprint.adb | 113 ++++++++++++++++++++++++++--------------------------- 1 file changed, 55 insertions(+), 58 deletions(-) (limited to 'gcc/ada/sprint.adb') diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 74da13f..ada95bc 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -184,10 +184,10 @@ package body Sprint is -- Print the given list with items separated by vertical "and" procedure Sprint_Aspect_Specifications (Node : Node_Id); - -- Node is a declaration node that accepts aspect specifications. This - -- procedure tests if aspect specifications are present, and if so prints - -- them, with a terminating semicolon. If no aspect specifications are - -- present, then a single semicolon is output. + -- Node is a declaration node that has aspect specifications (Has_Aspects + -- flag set True). It is called after outputting the terminating semicolon + -- for the related node. The effect is to remove the semicolon and print + -- the aspect specifications, followed by a terminating semicolon. procedure Sprint_Bar_List (List : List_Id); -- Print the given list with items separated by vertical bars @@ -631,40 +631,37 @@ package body Sprint is ---------------------------------- procedure Sprint_Aspect_Specifications (Node : Node_Id) is - AS : List_Id; + AS : constant List_Id := Aspect_Specifications (Node); A : Node_Id; begin - if Has_Aspect_Specifications (Node) then - AS := Aspect_Specifications (Node); - Indent := Indent + 2; - Write_Indent; - Write_Str ("with "); - Indent := Indent + 5; + Write_Erase_Char (';'); + Indent := Indent + 2; + Write_Indent; + Write_Str ("with "); + Indent := Indent + 5; - A := First (AS); - loop - Sprint_Node (Identifier (A)); + A := First (AS); + loop + Sprint_Node (Identifier (A)); - if Class_Present (A) then - Write_Str ("'Class"); - end if; + if Class_Present (A) then + Write_Str ("'Class"); + end if; - if Present (Expression (A)) then - Write_Str (" => "); - Sprint_Node (Expression (A)); - end if; + if Present (Expression (A)) then + Write_Str (" => "); + Sprint_Node (Expression (A)); + end if; - Next (A); + Next (A); - exit when No (A); - Write_Char (','); - Write_Indent; - end loop; - - Indent := Indent - 7; - end if; + exit when No (A); + Write_Char (','); + Write_Indent; + end loop; + Indent := Indent - 7; Write_Char (';'); end Sprint_Aspect_Specifications; @@ -864,8 +861,7 @@ package body Sprint is Write_Indent; Sprint_Node (Specification (Node)); Write_Str_With_Col_Check (" is "); - Write_Str_Sloc ("abstract"); - Sprint_Aspect_Specifications (Node); + Write_Str_Sloc ("abstract;"); when N_Accept_Alternative => Sprint_Node_List (Pragmas_Before (Node)); @@ -1274,7 +1270,7 @@ package body Sprint is Sprint_Node (Expression (Node)); end if; - Sprint_Aspect_Specifications (Node); + Write_Char (';'); end if; when N_Component_List => @@ -1503,7 +1499,7 @@ package body Sprint is end if; Write_Param_Specs (Node); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Entry_Index_Specification => Write_Str_With_Col_Check_Sloc ("for "); @@ -1549,7 +1545,7 @@ package body Sprint is Sprint_Node (Expression (Node)); end if; - Sprint_Aspect_Specifications (Node); + Write_Char (';'); end if; when N_Exception_Handler => @@ -1675,7 +1671,7 @@ package body Sprint is Sprint_Node (Default_Name (Node)); end if; - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Formal_Concrete_Subprogram_Declaration => Write_Indent_Str_Sloc ("with "); @@ -1688,7 +1684,7 @@ package body Sprint is Sprint_Node (Default_Name (Node)); end if; - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Formal_Discrete_Type_Definition => Write_Str_With_Col_Check_Sloc ("<>"); @@ -1736,7 +1732,7 @@ package body Sprint is Sprint_Node (Default_Expression (Node)); end if; - Sprint_Aspect_Specifications (Node); + Write_Char (';'); end if; when N_Formal_Ordinary_Fixed_Point_Definition => @@ -1747,8 +1743,7 @@ package body Sprint is Write_Id (Defining_Identifier (Node)); Write_Str_With_Col_Check (" is new "); Sprint_Node (Name (Node)); - Write_Str_With_Col_Check (" (<>)"); - Sprint_Aspect_Specifications (Node); + Write_Str_With_Col_Check (" (<>);"); when N_Formal_Private_Type_Definition => if Abstract_Present (Node) then @@ -1780,7 +1775,7 @@ package body Sprint is Write_Str_With_Col_Check (" is "); Sprint_Node (Formal_Type_Definition (Node)); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Free_Statement => Write_Indent_Str_Sloc ("free "); @@ -1821,7 +1816,7 @@ package body Sprint is Write_Discr_Specs (Node); Write_Str_With_Col_Check (" is "); Sprint_Node (Type_Definition (Node)); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Function_Call => Set_Debug_Sloc; @@ -1834,7 +1829,7 @@ package body Sprint is Write_Str_With_Col_Check (" is new "); Sprint_Node (Name (Node)); Sprint_Opt_Paren_Comma_List (Generic_Associations (Node)); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Function_Specification => Write_Str_With_Col_Check_Sloc ("function "); @@ -1875,7 +1870,7 @@ package body Sprint is Sprint_Indented_List (Generic_Formal_Declarations (Node)); Write_Indent; Sprint_Node (Specification (Node)); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Generic_Package_Renaming_Declaration => Write_Indent_Str_Sloc ("generic package "); @@ -1897,7 +1892,7 @@ package body Sprint is Sprint_Indented_List (Generic_Formal_Declarations (Node)); Write_Indent; Sprint_Node (Specification (Node)); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Goto_Statement => Write_Indent_Str_Sloc ("goto "); @@ -2128,7 +2123,7 @@ package body Sprint is Sprint_Node (Expression (Node)); end if; - Sprint_Aspect_Specifications (Node); + Write_Char (';'); -- Handle implicit importation and implicit exportation of -- object declarations: @@ -2369,7 +2364,7 @@ package body Sprint is Extra_Blank_Line; Write_Indent; Sprint_Node_Sloc (Specification (Node)); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Package_Instantiation => Extra_Blank_Line; @@ -2378,7 +2373,7 @@ package body Sprint is Write_Str (" is new "); Sprint_Node (Name (Node)); Sprint_Opt_Paren_Comma_List (Generic_Associations (Node)); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Package_Renaming_Declaration => Write_Indent_Str_Sloc ("package "); @@ -2479,8 +2474,7 @@ package body Sprint is Sprint_And_List (Interface_List (Node)); end if; - Write_Str_With_Col_Check (" with private"); - Sprint_Aspect_Specifications (Node); + Write_Str_With_Col_Check (" with private;"); when N_Private_Type_Declaration => Write_Indent_Str_Sloc ("type "); @@ -2502,8 +2496,7 @@ package body Sprint is Write_Str_With_Col_Check ("limited "); end if; - Write_Str_With_Col_Check ("private"); - Sprint_Aspect_Specifications (Node); + Write_Str_With_Col_Check ("private;"); when N_Push_Constraint_Error_Label => Write_Indent_Str ("%push_constraint_error_label ("); @@ -2566,7 +2559,7 @@ package body Sprint is Write_Str_With_Col_Check (" is new "); Sprint_Node (Name (Node)); Sprint_Opt_Paren_Comma_List (Generic_Associations (Node)); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Procedure_Specification => Write_Str_With_Col_Check_Sloc ("procedure "); @@ -2613,7 +2606,7 @@ package body Sprint is Sprint_Node (Protected_Definition (Node)); Write_Id (Defining_Identifier (Node)); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Qualified_Expression => Sprint_Node (Subtype_Mark (Node)); @@ -2809,7 +2802,7 @@ package body Sprint is Write_Str (" is"); Sprint_Node (Protected_Definition (Node)); Write_Id (Defining_Identifier (Node)); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Single_Task_Declaration => Write_Indent_Str_Sloc ("task "); @@ -2820,7 +2813,7 @@ package body Sprint is Sprint_Node (Task_Definition (Node)); end if; - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Selected_Component => Sprint_Node (Prefix (Node)); @@ -2893,7 +2886,7 @@ package body Sprint is Write_Str_With_Col_Check (" is null"); end if; - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Subprogram_Info => Sprint_Node (Identifier (Node)); @@ -2918,7 +2911,7 @@ package body Sprint is end if; Sprint_Node (Subtype_Indication (Node)); - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Subtype_Indication => Sprint_Node_Sloc (Subtype_Mark (Node)); @@ -2981,7 +2974,7 @@ package body Sprint is Sprint_Node (Task_Definition (Node)); end if; - Sprint_Aspect_Specifications (Node); + Write_Char (';'); when N_Terminate_Alternative => Sprint_Node_List (Pragmas_Before (Node)); @@ -3144,6 +3137,10 @@ package body Sprint is end if; end case; + if Has_Aspects (Node) then + Sprint_Aspect_Specifications (Node); + end if; + if Nkind (Node) in N_Subexpr and then Do_Range_Check (Node) then -- cgit v1.1