diff options
Diffstat (limited to 'gcc/ada/sprint.adb')
| -rw-r--r-- | gcc/ada/sprint.adb | 184 |
1 files changed, 118 insertions, 66 deletions
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index c35ef0df039..74da13ff47d 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Aspects; use Aspects; with Atree; use Atree; with Casing; use Casing; with Csets; use Csets; @@ -182,6 +183,12 @@ package body Sprint is procedure Sprint_And_List (List : List_Id); -- 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. + procedure Sprint_Bar_List (List : List_Id); -- Print the given list with items separated by vertical bars @@ -619,6 +626,48 @@ package body Sprint is end if; end Sprint_And_List; + ---------------------------------- + -- Sprint_Aspect_Specifications -- + ---------------------------------- + + procedure Sprint_Aspect_Specifications (Node : Node_Id) is + AS : List_Id; + 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; + + A := First (AS); + loop + Sprint_Node (Identifier (A)); + + if Class_Present (A) then + Write_Str ("'Class"); + end if; + + if Present (Expression (A)) then + Write_Str (" => "); + Sprint_Node (Expression (A)); + end if; + + Next (A); + + exit when No (A); + Write_Char (','); + Write_Indent; + end loop; + + Indent := Indent - 7; + end if; + + Write_Char (';'); + end Sprint_Aspect_Specifications; + --------------------- -- Sprint_Bar_List -- --------------------- @@ -815,7 +864,8 @@ package body Sprint is Write_Indent; Sprint_Node (Specification (Node)); Write_Str_With_Col_Check (" is "); - Write_Str_Sloc ("abstract;"); + Write_Str_Sloc ("abstract"); + Sprint_Aspect_Specifications (Node); when N_Accept_Alternative => Sprint_Node_List (Pragmas_Before (Node)); @@ -1224,7 +1274,7 @@ package body Sprint is Sprint_Node (Expression (Node)); end if; - Write_Char (';'); + Sprint_Aspect_Specifications (Node); end if; when N_Component_List => @@ -1453,7 +1503,7 @@ package body Sprint is end if; Write_Param_Specs (Node); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Entry_Index_Specification => Write_Str_With_Col_Check_Sloc ("for "); @@ -1499,7 +1549,7 @@ package body Sprint is Sprint_Node (Expression (Node)); end if; - Write_Char (';'); + Sprint_Aspect_Specifications (Node); end if; when N_Exception_Handler => @@ -1625,7 +1675,7 @@ package body Sprint is Sprint_Node (Default_Name (Node)); end if; - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Formal_Concrete_Subprogram_Declaration => Write_Indent_Str_Sloc ("with "); @@ -1638,7 +1688,7 @@ package body Sprint is Sprint_Node (Default_Name (Node)); end if; - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Formal_Discrete_Type_Definition => Write_Str_With_Col_Check_Sloc ("<>"); @@ -1686,7 +1736,7 @@ package body Sprint is Sprint_Node (Default_Expression (Node)); end if; - Write_Char (';'); + Sprint_Aspect_Specifications (Node); end if; when N_Formal_Ordinary_Fixed_Point_Definition => @@ -1697,7 +1747,8 @@ 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 (" (<>);"); + Write_Str_With_Col_Check (" (<>)"); + Sprint_Aspect_Specifications (Node); when N_Formal_Private_Type_Definition => if Abstract_Present (Node) then @@ -1729,7 +1780,7 @@ package body Sprint is Write_Str_With_Col_Check (" is "); Sprint_Node (Formal_Type_Definition (Node)); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Free_Statement => Write_Indent_Str_Sloc ("free "); @@ -1770,7 +1821,7 @@ package body Sprint is Write_Discr_Specs (Node); Write_Str_With_Col_Check (" is "); Sprint_Node (Type_Definition (Node)); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Function_Call => Set_Debug_Sloc; @@ -1783,7 +1834,7 @@ package body Sprint is Write_Str_With_Col_Check (" is new "); Sprint_Node (Name (Node)); Sprint_Opt_Paren_Comma_List (Generic_Associations (Node)); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Function_Specification => Write_Str_With_Col_Check_Sloc ("function "); @@ -1824,7 +1875,7 @@ package body Sprint is Sprint_Indented_List (Generic_Formal_Declarations (Node)); Write_Indent; Sprint_Node (Specification (Node)); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Generic_Package_Renaming_Declaration => Write_Indent_Str_Sloc ("generic package "); @@ -1846,7 +1897,7 @@ package body Sprint is Sprint_Indented_List (Generic_Formal_Declarations (Node)); Write_Indent; Sprint_Node (Specification (Node)); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Goto_Statement => Write_Indent_Str_Sloc ("goto "); @@ -2077,7 +2128,7 @@ package body Sprint is Sprint_Node (Expression (Node)); end if; - Write_Char (';'); + Sprint_Aspect_Specifications (Node); -- Handle implicit importation and implicit exportation of -- object declarations: @@ -2318,7 +2369,7 @@ package body Sprint is Extra_Blank_Line; Write_Indent; Sprint_Node_Sloc (Specification (Node)); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Package_Instantiation => Extra_Blank_Line; @@ -2327,7 +2378,7 @@ package body Sprint is Write_Str (" is new "); Sprint_Node (Name (Node)); Sprint_Opt_Paren_Comma_List (Generic_Associations (Node)); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Package_Renaming_Declaration => Write_Indent_Str_Sloc ("package "); @@ -2410,6 +2461,50 @@ package body Sprint is when N_Pop_Storage_Error_Label => Write_Indent_Str ("%pop_storage_error_label"); + when N_Private_Extension_Declaration => + Write_Indent_Str_Sloc ("type "); + Write_Id (Defining_Identifier (Node)); + + if Present (Discriminant_Specifications (Node)) then + Write_Discr_Specs (Node); + elsif Unknown_Discriminants_Present (Node) then + Write_Str_With_Col_Check ("(<>)"); + end if; + + Write_Str_With_Col_Check (" is new "); + Sprint_Node (Subtype_Indication (Node)); + + if Present (Interface_List (Node)) then + Write_Str_With_Col_Check (" and "); + Sprint_And_List (Interface_List (Node)); + end if; + + Write_Str_With_Col_Check (" with private"); + Sprint_Aspect_Specifications (Node); + + when N_Private_Type_Declaration => + Write_Indent_Str_Sloc ("type "); + Write_Id (Defining_Identifier (Node)); + + if Present (Discriminant_Specifications (Node)) then + Write_Discr_Specs (Node); + elsif Unknown_Discriminants_Present (Node) then + Write_Str_With_Col_Check ("(<>)"); + end if; + + Write_Str (" is "); + + if Tagged_Present (Node) then + Write_Str_With_Col_Check ("tagged "); + end if; + + if Limited_Present (Node) then + Write_Str_With_Col_Check ("limited "); + end if; + + Write_Str_With_Col_Check ("private"); + Sprint_Aspect_Specifications (Node); + when N_Push_Constraint_Error_Label => Write_Indent_Str ("%push_constraint_error_label ("); @@ -2458,48 +2553,6 @@ package body Sprint is Sprint_Node (Expression (Node)); - when N_Private_Type_Declaration => - Write_Indent_Str_Sloc ("type "); - Write_Id (Defining_Identifier (Node)); - - if Present (Discriminant_Specifications (Node)) then - Write_Discr_Specs (Node); - elsif Unknown_Discriminants_Present (Node) then - Write_Str_With_Col_Check ("(<>)"); - end if; - - Write_Str (" is "); - - if Tagged_Present (Node) then - Write_Str_With_Col_Check ("tagged "); - end if; - - if Limited_Present (Node) then - Write_Str_With_Col_Check ("limited "); - end if; - - Write_Str_With_Col_Check ("private;"); - - when N_Private_Extension_Declaration => - Write_Indent_Str_Sloc ("type "); - Write_Id (Defining_Identifier (Node)); - - if Present (Discriminant_Specifications (Node)) then - Write_Discr_Specs (Node); - elsif Unknown_Discriminants_Present (Node) then - Write_Str_With_Col_Check ("(<>)"); - end if; - - Write_Str_With_Col_Check (" is new "); - Sprint_Node (Subtype_Indication (Node)); - - if Present (Interface_List (Node)) then - Write_Str_With_Col_Check (" and "); - Sprint_And_List (Interface_List (Node)); - end if; - - Write_Str_With_Col_Check (" with private;"); - when N_Procedure_Call_Statement => Write_Indent; Set_Debug_Sloc; @@ -2513,7 +2566,7 @@ package body Sprint is Write_Str_With_Col_Check (" is new "); Sprint_Node (Name (Node)); Sprint_Opt_Paren_Comma_List (Generic_Associations (Node)); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Procedure_Specification => Write_Str_With_Col_Check_Sloc ("procedure "); @@ -2560,7 +2613,7 @@ package body Sprint is Sprint_Node (Protected_Definition (Node)); Write_Id (Defining_Identifier (Node)); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Qualified_Expression => Sprint_Node (Subtype_Mark (Node)); @@ -2756,7 +2809,7 @@ package body Sprint is Write_Str (" is"); Sprint_Node (Protected_Definition (Node)); Write_Id (Defining_Identifier (Node)); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Single_Task_Declaration => Write_Indent_Str_Sloc ("task "); @@ -2767,7 +2820,7 @@ package body Sprint is Sprint_Node (Task_Definition (Node)); end if; - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Selected_Component => Sprint_Node (Prefix (Node)); @@ -2840,7 +2893,7 @@ package body Sprint is Write_Str_With_Col_Check (" is null"); end if; - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Subprogram_Info => Sprint_Node (Identifier (Node)); @@ -2865,7 +2918,7 @@ package body Sprint is end if; Sprint_Node (Subtype_Indication (Node)); - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Subtype_Indication => Sprint_Node_Sloc (Subtype_Mark (Node)); @@ -2928,11 +2981,10 @@ package body Sprint is Sprint_Node (Task_Definition (Node)); end if; - Write_Char (';'); + Sprint_Aspect_Specifications (Node); when N_Terminate_Alternative => Sprint_Node_List (Pragmas_Before (Node)); - Write_Indent; if Present (Condition (Node)) then |