From 9d5a8d8539ef787744485ee1d74d0bbfabf73139 Mon Sep 17 00:00:00 2001 From: Monika Kurovszky Date: Mon, 9 Jan 2023 10:45:12 +0100 Subject: [PATCH] VC19-020: Modify Ada_Membership_Expr template * Fixing formatting of membership expressions and split before "|" operator in tall or no-compact mode * Fixing --layout switch behavior for minimal * Adding specific testcase * Update baselines for 2 public tests Change-Id: I41eae5daa207b48cc6cb78289ebbc629fd25deb1 --- src/pp-actions.adb | 4 +- .../tests/pp/S225-027/in/lal_extensions.ads | 6 +- .../tests/pp/S225-027/in/metrics-actions.adb | 84 ++++++++-------- .../pp/S225-027/in/metrics-line_counting.ads | 2 +- testsuite/tests/pp/S225-027/in/pp-actions.adb | 64 ++++++------- testsuite/tests/pp/S225-027/in/pp-buffers.adb | 4 +- .../tests/pp/S225-027/in/pp-command_lines.ads | 2 +- .../tests/pp/S225-027/in/pp-formatting.adb | 8 +- testsuite/tests/pp/S225-027/in/pp-scanner.adb | 8 +- testsuite/tests/pp/S225-027/in/pp-scanner.ads | 2 +- .../tests/pp/S225-027/in/stub-actions.adb | 4 +- .../in/utils-var_length_ints-test.adb | 4 +- testsuite/tests/pp/VB25-014/test.out | 3 +- testsuite/tests/pp/VC19-020/default.gpr | 9 ++ testsuite/tests/pp/VC19-020/main.adb | 13 +++ testsuite/tests/pp/VC19-020/test.out | 96 +++++++++++++++++++ testsuite/tests/pp/VC19-020/test.sh | 14 +++ testsuite/tests/pp/VC19-020/test.yaml | 3 + 18 files changed, 232 insertions(+), 98 deletions(-) create mode 100644 testsuite/tests/pp/VC19-020/default.gpr create mode 100644 testsuite/tests/pp/VC19-020/main.adb create mode 100644 testsuite/tests/pp/VC19-020/test.out create mode 100644 testsuite/tests/pp/VC19-020/test.sh create mode 100644 testsuite/tests/pp/VC19-020/test.yaml diff --git a/src/pp-actions.adb b/src/pp-actions.adb index 01e81161..980f61c3 100644 --- a/src/pp-actions.adb +++ b/src/pp-actions.adb @@ -324,7 +324,7 @@ package body Pp.Actions is Set_Arg (Cmd, Indent_Named_Statements, False); Set_Arg (Cmd, Insert_Blank_Lines, False); Set_Arg (Cmd, Preserve_Blank_Lines, True); - Set_Arg (Cmd, Source_Line_Breaks, True); + Set_Arg (Cmd, Source_Line_Breaks, False); Set_Arg (Cmd, Comments_Unchanged, True); Set_Arg (Cmd, Comments_Gnat_Beginning, False); Set_Arg (Cmd, Comments_Fill, False); @@ -1081,7 +1081,7 @@ package body Pp.Actions is when Ada_If_Expr => L ("if[#1 !]#1 then[#1 !]", "? #~ #~~", "?# else[ ~~]~"), when Ada_Membership_Expr => - L ("! ![# ?[#~ ^|# ~]~]"), + L ("! ![# ?~ #| ~~]"), when Ada_Dotted_Name => L ("![#1.!]"), when Ada_End_Name => L ("!"), diff --git a/testsuite/tests/pp/S225-027/in/lal_extensions.ads b/testsuite/tests/pp/S225-027/in/lal_extensions.ads index ec0326e7..0d2a904f 100644 --- a/testsuite/tests/pp/S225-027/in/lal_extensions.ads +++ b/testsuite/tests/pp/S225-027/in/lal_extensions.ads @@ -55,11 +55,11 @@ package LAL_Extensions is function Id_Name (Nm : Ada_Node'Class) return W_Str with Pre => Kind (Nm) in Ada_Defining_Name | Ada_Identifier | - Ada_Int_Literal | Ada_Real_Literal | Ada_String_Literal | - Ada_Char_Literal; + Ada_Int_Literal | Ada_Real_Literal | Ada_String_Literal | + Ada_Char_Literal; function L_Name (Nm : Ada_Node'Class) return W_Str with Pre => Kind (Nm) in Ada_Defining_Name | Ada_Identifier | - Ada_String_Literal; + Ada_String_Literal; -- Text name of an identifier. The L_Name is converted to lower -- case. diff --git a/testsuite/tests/pp/S225-027/in/metrics-actions.adb b/testsuite/tests/pp/S225-027/in/metrics-actions.adb index e5831a1f..adac1c4f 100644 --- a/testsuite/tests/pp/S225-027/in/metrics-actions.adb +++ b/testsuite/tests/pp/S225-027/in/metrics-actions.adb @@ -269,11 +269,11 @@ package body METRICS.Actions is subtype Gnatmetric_Eligible is Ada_Node_Kind_Type with Predicate => Gnatmetric_Eligible in Ada_Expr_Function | - Ada_Generic_Package_Decl | Ada_Package_Body | Ada_Package_Decl | - Ada_Protected_Body | Ada_Single_Protected_Decl | - Ada_Protected_Type_Decl | Ada_Entry_Body | Ada_Subp_Body | - Ada_Subp_Body_Stub | Ada_Generic_Subp_Instantiation | - Ada_Task_Body | Ada_Single_Task_Decl | Ada_Task_Type_Decl; + Ada_Generic_Package_Decl | Ada_Package_Body | Ada_Package_Decl | + Ada_Protected_Body | Ada_Single_Protected_Decl | + Ada_Protected_Type_Decl | Ada_Entry_Body | Ada_Subp_Body | + Ada_Subp_Body_Stub | Ada_Generic_Subp_Instantiation | + Ada_Task_Body | Ada_Single_Task_Decl | Ada_Task_Type_Decl; -- These are the node kinds that the gnatmetric documentation calls -- "eligible local units". We compute metrics for the outermost node (the -- compilation unit, for the file-level metrics), and the library item or @@ -283,15 +283,15 @@ package body METRICS.Actions is subtype Contract_Complexity_Eligible is Ada_Node_Kind_Type with Predicate => Contract_Complexity_Eligible in Ada_Generic_Subp_Decl | - Ada_Abstract_Subp_Decl | Ada_Null_Subp_Decl | - Ada_Subp_Renaming_Decl | Ada_Subp_Decl; + Ada_Abstract_Subp_Decl | Ada_Null_Subp_Decl | + Ada_Subp_Renaming_Decl | Ada_Subp_Decl; -- For the new lalmetric tool, we have the --contract-complexity -- metric, which is on subprogram declarations, so we need -- additional "eligible" nodes. subtype Eligible is Ada_Node_Kind_Type with Predicate => Eligible in Gnatmetric_Eligible | - Contract_Complexity_Eligible; + Contract_Complexity_Eligible; function Q (S : String) return String is -- quote ("""" & S & """"); @@ -671,8 +671,8 @@ package body METRICS.Actions is begin return Has_Complexity_Metrics (Outer_Unit) or else Kind (Outer_Unit) in Ada_Package_Decl | - Ada_Generic_Package_Decl | Ada_Package_Body | - Ada_Protected_Body; + Ada_Generic_Package_Decl | Ada_Package_Body | + Ada_Protected_Body; end; when Ada_Expr_Function | Ada_Entry_Body | Ada_Subp_Body | @@ -869,14 +869,14 @@ package body METRICS.Actions is if Depth > 3 and then M.Kind in Contract_Complexity_Eligible and then Metric not in Contract_Complexity | Param_Number | - In_Parameters | Out_Parameters | In_Out_Parameters + In_Parameters | Out_Parameters | In_Out_Parameters then return False; end if; if M.Kind in Ada_Subp_Body_Stub | Ada_Generic_Subp_Instantiation and then Metric not in Param_Number | In_Parameters | Out_Parameters | - In_Out_Parameters + In_Out_Parameters then return False; end if; @@ -896,7 +896,7 @@ package body METRICS.Actions is return (Depth = 3 and then M.Kind in Ada_Package_Body | Ada_Subp_Body | - Ada_Task_Body | Ada_Protected_Body) + Ada_Task_Body | Ada_Protected_Body) or else (XML and then Depth = 1); when All_Types | Public_Types => return (Depth = 3 or else (XML and then Depth = 1)) @@ -917,7 +917,7 @@ package body METRICS.Actions is if Depth = 3 then if M.Kind in Ada_Package_Decl | Ada_Generic_Package_Decl | - Ada_Subp_Decl | Ada_Generic_Subp_Decl + Ada_Subp_Decl | Ada_Generic_Subp_Decl then return True; end if; @@ -937,7 +937,7 @@ package body METRICS.Actions is return False; when Param_Number => if M.Kind in Ada_Subp_Decl | Ada_Generic_Subp_Instantiation | - Ada_Expr_Function | Ada_Null_Subp_Decl + Ada_Expr_Function | Ada_Null_Subp_Decl then return True; end if; @@ -1046,7 +1046,7 @@ package body METRICS.Actions is Adjust : constant Metric_Nat := (if Metric in Complexity_Statement | Complexity_Cyclomatic | - Complexity_Essential + Complexity_Essential then Num - 1 else 0); Numerator_Metric : constant Metrics_Enum := @@ -2617,7 +2617,7 @@ package body METRICS.Actions is function In_Visible_Part return Boolean is (Last_Index (Metrix_Stack) >= 3 and then Element (Metrix_Stack, 3).Kind in Ada_Package_Decl | - Ada_Generic_Package_Decl + Ada_Generic_Package_Decl and then not Element (Metrix_Stack, 3).Is_Private_Lib_Unit and then Private_Part_Count = 0); -- True if we're within only visible parts. Note that it is possible to @@ -2952,8 +2952,8 @@ package body METRICS.Actions is -- Push the stack if appropriate if Kind (Node) in Gnatmetric_Eligible | Ada_If_Stmt | Ada_Case_Stmt | - Ada_For_Loop_Stmt | Ada_Loop_Stmt | Ada_While_Loop_Stmt | - Ada_Select_Stmt + Ada_For_Loop_Stmt | Ada_Loop_Stmt | Ada_While_Loop_Stmt | + Ada_Select_Stmt then Push (EC_Stack, EC_Rec'(Node, Counted => False)); -- (The corresponding Pop is at the end of @@ -2963,8 +2963,8 @@ package body METRICS.Actions is -- If this is a jump, increment appropriate counts if Kind (Node) in -- Not Ada_Extended_Return_Stmt - Ada_Return_Stmt | Ada_Raise_Stmt | - Ada_Terminate_Alternative | Ada_Goto_Stmt + Ada_Return_Stmt | Ada_Raise_Stmt | + Ada_Terminate_Alternative | Ada_Goto_Stmt or else (Kind (Node) = Ada_Exit_Stmt and then Tool.Treat_Exit_As_Goto) then @@ -2986,7 +2986,7 @@ package body METRICS.Actions is exit when X = 1; exit when Kind (Node) = Ada_Exit_Stmt and then K in Ada_For_Loop_Stmt | Ada_Loop_Stmt | - Ada_While_Loop_Stmt; + Ada_While_Loop_Stmt; X := X - 1; end loop; @@ -3476,8 +3476,8 @@ package body METRICS.Actions is -- Param_Number and friends if Kind (Node) in Ada_Subp_Decl | Ada_Expr_Function | - Ada_Abstract_Subp_Decl | Ada_Null_Subp_Decl | - Ada_Subp_Renaming_Decl | Ada_Subp_Body | Ada_Subp_Body_Stub + Ada_Abstract_Subp_Decl | Ada_Null_Subp_Decl | + Ada_Subp_Renaming_Decl | Ada_Subp_Body | Ada_Subp_Body_Stub then declare pragma Assert (Node = M.Node); @@ -3508,7 +3508,7 @@ package body METRICS.Actions is if Last_Index (Metrix_Stack) = 3 or else In_Visible_Part then if Node = M.Node and then not M.Is_Private_Lib_Unit then if M.Kind in Ada_Subp_Decl | Ada_Abstract_Subp_Decl | - Ada_Generic_Subp_Decl + Ada_Generic_Subp_Decl -- Not Ada_Subp_Renaming_Decl then @@ -3558,12 +3558,12 @@ package body METRICS.Actions is if Kind (Node) in Ada_Basic_Decl | Ada_Entry_Index_Spec and then Kind (Node) not in Ada_Generic_Formal | - Ada_Generic_Formal_Obj_Decl | Ada_Generic_Formal_Package | - Ada_Generic_Formal_Subp_Decl | Ada_Generic_Formal_Type_Decl | - Ada_Generic_Package_Internal | Ada_Anonymous_Type_Decl | - Ada_Named_Stmt_Decl | Ada_Label_Decl | - Ada_Single_Task_Type_Decl | Ada_Generic_Subp_Internal | - Ada_Exception_Handler + Ada_Generic_Formal_Obj_Decl | Ada_Generic_Formal_Package | + Ada_Generic_Formal_Subp_Decl | Ada_Generic_Formal_Type_Decl | + Ada_Generic_Package_Internal | Ada_Anonymous_Type_Decl | + Ada_Named_Stmt_Decl | Ada_Label_Decl | + Ada_Single_Task_Type_Decl | Ada_Generic_Subp_Internal | + Ada_Exception_Handler then Inc_All (Declarations); Inc_All (Logical_Source_Lines); @@ -3580,8 +3580,8 @@ package body METRICS.Actions is if In_Visible_Part then if not M.Is_Private_Lib_Unit and not In_Generic_Formal_Part then if Kind (Node) in Ada_Type_Decl | Ada_Protected_Type_Decl | - Ada_Task_Type_Decl | Ada_Incomplete_Type_Decl | - Ada_Incomplete_Tagged_Type_Decl + Ada_Task_Type_Decl | Ada_Incomplete_Type_Decl | + Ada_Incomplete_Tagged_Type_Decl then Inc_All (Public_Types); end if; @@ -3605,8 +3605,8 @@ package body METRICS.Actions is -- All_Types if Kind (Node) in Ada_Type_Decl | Ada_Protected_Type_Decl | - Ada_Task_Type_Decl | Ada_Incomplete_Type_Decl | - Ada_Incomplete_Tagged_Type_Decl + Ada_Task_Type_Decl | Ada_Incomplete_Type_Decl | + Ada_Incomplete_Tagged_Type_Decl then if P_Previous_Part (Node.As_Base_Type_Decl).Is_Null and then Node.Parent.Kind /= Ada_Generic_Formal_Type_Decl @@ -3640,15 +3640,15 @@ package body METRICS.Actions is -- Construct_Nesting if Kind (Node) in Ada_Subp_Decl | Ada_Expr_Function | - Ada_Generic_Subp_Decl | Ada_Task_Type_Decl | - Ada_Single_Task_Decl | Ada_Protected_Type_Decl | - Ada_Single_Protected_Decl | Ada_Generic_Package_Instantiation | - Ada_Generic_Subp_Instantiation + Ada_Generic_Subp_Decl | Ada_Task_Type_Decl | + Ada_Single_Task_Decl | Ada_Protected_Type_Decl | + Ada_Single_Protected_Decl | Ada_Generic_Package_Instantiation | + Ada_Generic_Subp_Instantiation then pragma Assert (M.Vals (Construct_Nesting) = 0 or else Kind (Node) in Ada_Generic_Package_Instantiation | - Ada_Generic_Subp_Instantiation); + Ada_Generic_Subp_Instantiation); if M.Vals (Construct_Nesting) = 0 then M.Vals (Construct_Nesting) := 1; end if; @@ -3934,7 +3934,7 @@ package body METRICS.Actions is Gather_Syntax_Metrics (Node, M); if Kind (Node) in Ada_Package_Decl | Ada_Generic_Package_Decl | - Ada_Task_Def | Ada_Protected_Def + Ada_Task_Def | Ada_Protected_Def and then In_Visible_Part then -- We gather contract metrics only for public subprograms @@ -3961,7 +3961,7 @@ package body METRICS.Actions is begin if not Cur_Child.Is_Null then if Kind (Node) in Ada_Generic_Package_Decl | - Ada_Generic_Subp_Decl + Ada_Generic_Subp_Decl then pragma Assert ((I = 1) = diff --git a/testsuite/tests/pp/S225-027/in/metrics-line_counting.ads b/testsuite/tests/pp/S225-027/in/metrics-line_counting.ads index be27beba..6f14ecc6 100644 --- a/testsuite/tests/pp/S225-027/in/metrics-line_counting.ads +++ b/testsuite/tests/pp/S225-027/in/metrics-line_counting.ads @@ -13,7 +13,7 @@ package METRICS.Line_Counting is subtype Cumulative_Metrics is Lines_Metrics with Predicate => Cumulative_Metrics in Lines_Code | Lines_Comment | - Lines_Eol_Comment | Lines_Blank; + Lines_Eol_Comment | Lines_Blank; type Cumulative_Counts_Array (<>) is private; function Last (Counts : Cumulative_Counts_Array) return Slocs.Line_Number; diff --git a/testsuite/tests/pp/S225-027/in/pp-actions.adb b/testsuite/tests/pp/S225-027/in/pp-actions.adb index 7d2e73d7..73ef6677 100644 --- a/testsuite/tests/pp/S225-027/in/pp-actions.adb +++ b/testsuite/tests/pp/S225-027/in/pp-actions.adb @@ -314,7 +314,7 @@ package body Pp.Actions is pragma Unreferenced (Create_Modes); subtype Replace_Modes is Output_Modes with Predicate => Replace_Modes in Replace_Backup | Replace_Force_Backup | - Replace; + Replace; function Get_Output_Mode (Cmd : Command_Line) return Output_Modes; function Get_Output_Mode (Cmd : Command_Line) return Output_Modes is @@ -1207,10 +1207,10 @@ package body Pp.Actions is subtype Subp_Decl_Body_Kind is Ada_Tree_Kind with Predicate => Subp_Decl_Body_Kind in Ada_Subp_Decl | - Ada_Subp_Renaming_Decl | Ada_Access_To_Subp_Def | - Ada_Entry_Decl | Ada_Formal_Subp_Decl | Ada_Generic_Subp_Decl | - Ada_Subp_Body_Stub | Ada_Subp_Body | Ada_Abstract_Subp_Decl | - Ada_Expr_Function | Ada_Null_Subp_Decl | Ada_Entry_Body; + Ada_Subp_Renaming_Decl | Ada_Access_To_Subp_Def | + Ada_Entry_Decl | Ada_Formal_Subp_Decl | Ada_Generic_Subp_Decl | + Ada_Subp_Body_Stub | Ada_Subp_Body | Ada_Abstract_Subp_Decl | + Ada_Expr_Function | Ada_Null_Subp_Decl | Ada_Entry_Body; Str_Subp_Decl_With_Hard_Breaks_Alt_Table : array (Ada_Tree_Kind) of Str_Template_Ptr; @@ -1408,14 +1408,14 @@ package body Pp.Actions is for X of Result.Between.Instructions.all loop pragma Assert (X.Kind in Hard_Break | Hard_Break_No_Comment | - Soft_Break | Tab | Verbatim); + Soft_Break | Tab | Verbatim); end loop; end if; end Check_Between; subtype Illegal_Chars is Character with Predicate => Illegal_Chars in '~' | '"' | '\' | '%' | - '0' .. '9'; + '0' .. '9'; pragma Assert (Str (Text (Cur)).S (1) not in Illegal_Chars); -- Start of processing for Parse_Instruction @@ -1735,9 +1735,9 @@ package body Pp.Actions is declare subtype When_Kinds is Ada_Node_Kind_Type with Predicate => When_Kinds in Ada_Case_Stmt_Alternative | - -- ??? Ada_Case_Expr_Alternative | + -- ??? Ada_Case_Expr_Alternative | - Ada_Variant; + Ada_Variant; -- Things that start with "when" that we want to treat -- alike here. begin @@ -1788,7 +1788,7 @@ package body Pp.Actions is pragma Warnings (Off, "if it is invalid"); pragma Assert (Query_Index (Char_To_Digit (T (J + 1))) in - Constrained_Query_Count); + Constrained_Query_Count); pragma Warnings (On, "if it is invalid"); else Subtree_Count := Subtree_Count + 1; @@ -1800,11 +1800,11 @@ package body Pp.Actions is when '{' => if Kind in Ada_Component_List | Ada_Public_Part | - Ada_Generic_Formal_Part | Ada_Array_Type_Def | - Ada_Constrained_Array_Indices | + Ada_Generic_Formal_Part | Ada_Array_Type_Def | + Ada_Constrained_Array_Indices | - Ada_Case_Stmt_Alternative | - Ada_Case_Expr_Alternative | Ada_Variant + Ada_Case_Stmt_Alternative | + Ada_Case_Expr_Alternative | Ada_Variant then null; else @@ -2117,7 +2117,7 @@ package body Pp.Actions is when Mixed => if Kind in Ada_Attribute_Ref | Ada_Update_Attribute_Ref | - Ada_Pragma_Node + Ada_Pragma_Node then -- Handle pragma and attribute names that are special cases -- (some portion should be in ALL CAPS). @@ -2232,7 +2232,7 @@ package body Pp.Actions is procedure Indent (Amount : Integer) is pragma Assert (abs Amount in 0 | 1 | PP_Indentation (Cmd) | - PP_Indent_Continuation (Cmd) | Arg (Cmd, Initial_Indentation)); + PP_Indent_Continuation (Cmd) | Arg (Cmd, Initial_Indentation)); Last_LBI : constant Line_Break_Index := All_LBI (Last (All_LBI)); Last_LB : Line_Break renames All_LB (Last_LBI); begin @@ -2451,8 +2451,8 @@ package body Pp.Actions is is pragma Assert (Token_Text in Name_Tab_Insertion_Point | Name_With | Name_Use | - Name_Tab_In_Out | Name_Assign | Name_Colon | Name_Arrow | - Name_Bar | Name_At | Name_Range | Name_Dot_Dot | Name_R_Sq); + Name_Tab_In_Out | Name_Assign | Name_Colon | Name_Arrow | + Name_Bar | Name_At | Name_Range | Name_Dot_Dot | Name_R_Sq); Pa : Ada_Tree_Base := Parent; Tr : Ada_Tree_Base := Tree; @@ -2775,15 +2775,15 @@ package body Pp.Actions is subtype Absent_Kinds is Ada_Node_Kind_Type with Predicate => Absent_Kinds in Ada_Abort_Absent | - Ada_Abstract_Absent | Ada_Aliased_Absent | - Ada_All_Absent | Ada_Constant_Absent | - Ada_Limited_Absent | Ada_Not_Null_Absent | - Ada_Private_Absent | Ada_Protected_Absent | - Ada_Reverse_Absent | Ada_Synchronized_Absent | - Ada_Tagged_Absent | Ada_Until_Absent | - Ada_With_Private_Absent | - Ada_Mode_Default | - Ada_Overriding_Unspecified; + Ada_Abstract_Absent | Ada_Aliased_Absent | + Ada_All_Absent | Ada_Constant_Absent | + Ada_Limited_Absent | Ada_Not_Null_Absent | + Ada_Private_Absent | Ada_Protected_Absent | + Ada_Reverse_Absent | Ada_Synchronized_Absent | + Ada_Tagged_Absent | Ada_Until_Absent | + Ada_With_Private_Absent | + Ada_Mode_Default | + Ada_Overriding_Unspecified; -- This is needed because we have templates like "?~~ ~", which -- inserts a space after the subtree, which might be -- "private". But if "private" is not present, we don't want the @@ -2851,7 +2851,7 @@ package body Pp.Actions is elsif Inst_Index = TT.Instructions'Last then pragma Assert (Tree.Kind in Ada_Param_Spec | Ada_Object_Decl | - Ada_Extended_Return_Stmt_Object_Decl); + Ada_Extended_Return_Stmt_Object_Decl); return Name_Tab_In_Out; -- Except for the above special cases, we return @@ -3077,7 +3077,7 @@ package body Pp.Actions is and then X.Kind = Ada_Aggregate and then All_Named then if X.Parent.Kind in Ada_Object_Decl | Ada_Assign_Stmt | - Ada_Enum_Rep_Clause + Ada_Enum_Rep_Clause then Result := True; elsif X.Parent.Kind = Ada_Aggregate_Assoc then @@ -3245,7 +3245,7 @@ package body Pp.Actions is (Tree.Kind = Ada_Aspect_Assoc and then W_Intern (Id_Name (Subtree (Tree, 1))) in Name_Depends | - Name_Refined_Depends + Name_Refined_Depends and then Depends_RHS (Tree).Kind = Ada_Un_Op and then Subtree (Depends_RHS (Tree), 1).Kind = Ada_Op_Plus); @@ -3709,7 +3709,7 @@ package body Pp.Actions is procedure Do_Qual_Expr is begin if Subtree (Tree, 2).Kind in Ada_Aggregate | - Ada_Null_Record_Aggregate + Ada_Null_Record_Aggregate then Interpret_Alt_Template (Qualified_Aggr_Alt); else @@ -3731,7 +3731,7 @@ package body Pp.Actions is (if Is_Nil (Parent_Tree) or else Parent_Tree.Kind in Ada_Entry_Spec | Ada_Entry_Body | - Ada_Accept_Stmt | Ada_Accept_Stmt_With_Stmts + Ada_Accept_Stmt | Ada_Accept_Stmt_With_Stmts then False else Present (Parent_Tree.As_Subp_Spec.F_Subp_Returns)); Param_Count : Query_Count := diff --git a/testsuite/tests/pp/S225-027/in/pp-buffers.adb b/testsuite/tests/pp/S225-027/in/pp-buffers.adb index 8d8d0262..f67e02b4 100644 --- a/testsuite/tests/pp/S225-027/in/pp-buffers.adb +++ b/testsuite/tests/pp/S225-027/in/pp-buffers.adb @@ -293,7 +293,7 @@ package body Pp.Buffers is begin pragma Assert (Rec.Position in - Buf.From_First + 1 .. Last_Index (Buf.From) + 1); + Buf.From_First + 1 .. Last_Index (Buf.From) + 1); end; else @@ -1114,7 +1114,7 @@ package body Pp.Buffers is Fail ("Bad From_Marker flag"); end if; if Rec.Position not in - Buf.From_First + 1 .. Last_Index (Buf.From) + 1 + Buf.From_First + 1 .. Last_Index (Buf.From) + 1 then Fail ("Bad From_Marker position"); end if; diff --git a/testsuite/tests/pp/S225-027/in/pp-command_lines.ads b/testsuite/tests/pp/S225-027/in/pp-command_lines.ads index fcb31285..78695167 100644 --- a/testsuite/tests/pp/S225-027/in/pp-command_lines.ads +++ b/testsuite/tests/pp/S225-027/in/pp-command_lines.ads @@ -339,7 +339,7 @@ package Pp.Command_Lines is subtype Lower_Upper_Mixed_PP_Casing is PP_Casing with Predicate => Lower_Upper_Mixed_PP_Casing in Lower_Case | Upper_Case | - Mixed; + Mixed; subtype Cmd_Line is Command_Line; diff --git a/testsuite/tests/pp/S225-027/in/pp-formatting.adb b/testsuite/tests/pp/S225-027/in/pp-formatting.adb index 8dc50fb7..8ba39e0d 100644 --- a/testsuite/tests/pp/S225-027/in/pp-formatting.adb +++ b/testsuite/tests/pp/S225-027/in/pp-formatting.adb @@ -2778,7 +2778,7 @@ package body Pp.Formatting is -- Should the following list include "exception"??? return Kind (New_Tok) not in Res_Begin | Res_Else | Res_Elsif | - Res_When; + Res_When; end Look_Before; Indentation : Natural; @@ -2922,7 +2922,7 @@ package body Pp.Formatting is P : Tokn_Cursor := Last (New_Tokns'Access); begin while Kind (P) in Line_Break_Token | End_Of_Line_Comment | - Spaces + Spaces loop Prev (P); end loop; @@ -2954,7 +2954,7 @@ package body Pp.Formatting is Next_ss (Src_Tok); exit when Kind (Src_Tok) not in Special_Comment | - Fillable_Comment | Other_Whole_Line_Comment; + Fillable_Comment | Other_Whole_Line_Comment; Set_Cur_Indent; if True or else not Arg (Cmd, Source_Line_Breaks) then @@ -4079,7 +4079,7 @@ package body Pp.Formatting is loop Next (Next_Line_Break); exit when Kind (Next_Line_Break) in Enabled_LB_Token | - End_Of_Input; + End_Of_Input; end loop; when Tab_Token => diff --git a/testsuite/tests/pp/S225-027/in/pp-scanner.adb b/testsuite/tests/pp/S225-027/in/pp-scanner.adb index aa7fc502..f7b04966 100644 --- a/testsuite/tests/pp/S225-027/in/pp-scanner.adb +++ b/testsuite/tests/pp/S225-027/in/pp-scanner.adb @@ -784,8 +784,8 @@ package body Pp.Scanner is Normalized : constant Symbol := Same_Ignoring_Case (Text); begin if Normalized in - Potential_Reserved_Word_Sym'First .. - Last_Reserved_For_Ada_Version (Ada_Version) + Potential_Reserved_Word_Sym'First .. + Last_Reserved_For_Ada_Version (Ada_Version) then return Symbol_To_Reserved_Word_Map (Normalized); else @@ -1215,7 +1215,7 @@ package body Pp.Scanner is -- as opposed to Ada code. if Preceding_Lexeme in Ident | String_Lit | Res_Access | - Res_All | ')' | '!' + Res_All | ')' | '!' then -- it's a tick pragma Assert (if Preceding_Lexeme = '!' then Lang = Template_Lang); @@ -1471,7 +1471,7 @@ package body Pp.Scanner is (case Tok.Kind is when Comment_Kind => True, when EOL_Token => Inp in (1 => W_LF) | (W_CR, W_LF) | (1 => W_FF) | - (1 => W_VT) + (1 => W_VT) and then Outp = (1 => NL), when Reserved_Word => To_Lower (Inp) = Outp, when others => Inp = Outp); diff --git a/testsuite/tests/pp/S225-027/in/pp-scanner.ads b/testsuite/tests/pp/S225-027/in/pp-scanner.ads index e5a8aa76..9882d437 100644 --- a/testsuite/tests/pp/S225-027/in/pp-scanner.ads +++ b/testsuite/tests/pp/S225-027/in/pp-scanner.ads @@ -190,7 +190,7 @@ package Pp.Scanner is subtype Whole_Line_Comment is Token_Kind with Predicate => Whole_Line_Comment in Pp_Off_Comment | Pp_On_Comment | - Special_Comment | Fillable_Comment | Other_Whole_Line_Comment; + Special_Comment | Fillable_Comment | Other_Whole_Line_Comment; subtype Comment_Kind is Token_Kind with Predicate => Comment_Kind in Whole_Line_Comment | End_Of_Line_Comment; diff --git a/testsuite/tests/pp/S225-027/in/stub-actions.adb b/testsuite/tests/pp/S225-027/in/stub-actions.adb index 02562fcf..12cef9df 100644 --- a/testsuite/tests/pp/S225-027/in/stub-actions.adb +++ b/testsuite/tests/pp/S225-027/in/stub-actions.adb @@ -392,7 +392,7 @@ package body Stub.Actions is begin if Needs_Completion (Subtree) or else Subtree.Kind in Ada_Incomplete_Type_Decl | - Ada_Incomplete_Tagged_Type_Decl + Ada_Incomplete_Tagged_Type_Decl then return True; end if; @@ -769,7 +769,7 @@ package body Stub.Actions is Subtree : constant Ada_Node := Childx (Decls, X); begin if Subtree.Kind in Ada_Incomplete_Type_Decl | - Ada_Incomplete_Tagged_Type_Decl + Ada_Incomplete_Tagged_Type_Decl then declare Next_Part : constant Base_Type_Decl := diff --git a/testsuite/tests/pp/S225-027/in/utils-var_length_ints-test.adb b/testsuite/tests/pp/S225-027/in/utils-var_length_ints-test.adb index 496128d2..37ede65f 100644 --- a/testsuite/tests/pp/S225-027/in/utils-var_length_ints-test.adb +++ b/testsuite/tests/pp/S225-027/in/utils-var_length_ints-test.adb @@ -9,8 +9,8 @@ procedure Utils.Var_Length_Ints.Test is subtype Test_Cases is My_Int with Predicate => Test_Cases in 1 .. 1_000 | 16_000 .. 17_000 | - 2_097_100 .. 2_097_200 | 268_435_400 .. 268_435_500 | - My_Int'Last - 100 .. My_Int'Last; + 2_097_100 .. 2_097_200 | 268_435_400 .. 268_435_500 | + My_Int'Last - 100 .. My_Int'Last; begin for X in Test_Cases loop diff --git a/testsuite/tests/pp/VB25-014/test.out b/testsuite/tests/pp/VB25-014/test.out index 06b2c3c9..26490464 100644 --- a/testsuite/tests/pp/VB25-014/test.out +++ b/testsuite/tests/pp/VB25-014/test.out @@ -6,8 +6,7 @@ begin end Main; Minimal layout procedure Main is - type My_Enum is (One, Two, Three, - Four); + type My_Enum is (One, Two, Three, Four); begin null; end Main; diff --git a/testsuite/tests/pp/VC19-020/default.gpr b/testsuite/tests/pp/VC19-020/default.gpr new file mode 100644 index 00000000..090b4c9c --- /dev/null +++ b/testsuite/tests/pp/VC19-020/default.gpr @@ -0,0 +1,9 @@ +project Default is + + for Main use ("main.adb"); + + package Pretty_Printer is + for Default_Switches ("ada") use ("--no-compact", "--split-line-before-op"); + end Pretty_Printer; + +end Default; diff --git a/testsuite/tests/pp/VC19-020/main.adb b/testsuite/tests/pp/VC19-020/main.adb new file mode 100644 index 00000000..3ee2c34e --- /dev/null +++ b/testsuite/tests/pp/VC19-020/main.adb @@ -0,0 +1,13 @@ +procedure Main is + type My_Range is range 1 .. 100; + subtype First_Dozen is My_Range with + Static_Predicate => + First_Dozen in 1 .. 2 | 3 | 4 | 5 .. 6 | 7 .. 8 | 9 .. 10 | 11 .. 12 | 13 .. 14; + + +function Valid_Response_Code (Val : RFLX.RFLX_Types.Base_Integer) return Boolean is + (Val in 16#1# | 16#2# | 16#3# | 16#4# | 16#60# | 16#61# | 16#63# | 16#64# | 16#65# | 16#66# | 16#67# | 16#68# | 16#69# | 16#6A# | 16#6B# | 16#6C# | 16#7E# | 16#7F#); + +begin + null; +end Main; diff --git a/testsuite/tests/pp/VC19-020/test.out b/testsuite/tests/pp/VC19-020/test.out new file mode 100644 index 00000000..6a777605 --- /dev/null +++ b/testsuite/tests/pp/VC19-020/test.out @@ -0,0 +1,96 @@ +Testing --layout switch +1 --layout=default +procedure Main is + type My_Range is range 1 .. 100; + subtype First_Dozen is My_Range with + Static_Predicate => + First_Dozen in 1 .. 2 | 3 | 4 | 5 .. 6 | 7 .. 8 | 9 .. 10 | 11 .. 12 + | 13 .. 14; + + function Valid_Response_Code + (Val : RFLX.RFLX_Types.Base_Integer) return Boolean is + (Val in 16#1# | 16#2# | 16#3# | 16#4# | 16#60# | 16#61# | 16#63# | 16#64# + | 16#65# | 16#66# | 16#67# | 16#68# | 16#69# | 16#6A# | 16#6B# | 16#6C# + | 16#7E# | 16#7F#); + +begin + null; +end Main; +--------------------------------------------------- +2 --layout=minimal +procedure Main is + type My_Range is range 1 .. 100; + subtype First_Dozen is My_Range with + Static_Predicate => + First_Dozen in 1 .. 2 | 3 | 4 | 5 .. 6 | 7 .. 8 | 9 .. 10 | 11 .. 12 + | 13 .. 14; + + + function Valid_Response_Code + (Val : RFLX.RFLX_Types.Base_Integer) return Boolean is + (Val in 16#1# | 16#2# | 16#3# | 16#4# | 16#60# | 16#61# | 16#63# | 16#64# + | 16#65# | 16#66# | 16#67# | 16#68# | 16#69# | 16#6A# | 16#6B# | 16#6C# + | 16#7E# | 16#7F#); + +begin + null; +end Main; +--------------------------------------------------- +3 --layout=tall +procedure Main is + + type My_Range is range 1 .. 100; + subtype First_Dozen is My_Range with + Static_Predicate => + First_Dozen in + 1 .. 2 + | 3 + | 4 + | 5 .. 6 + | 7 .. 8 + | 9 .. 10 + | 11 .. 12 + | 13 .. 14; + function Valid_Response_Code + (Val: RFLX.RFLX_Types.Base_Integer) return Boolean is + (Val in + 16#1# + | 16#2# + | 16#3# + | 16#4# + | 16#60# + | 16#61# + | 16#63# + | 16#64# + | 16#65# + | 16#66# + | 16#67# + | 16#68# + | 16#69# + | 16#6A# + | 16#6B# + | 16#6C# + | 16#7E# + | 16#7F#); + +begin + null; +end Main; +--------------------------------------------------- +4 --layout=compact +procedure Main is + type My_Range is range 1 .. 100; + subtype First_Dozen is My_Range with + Static_Predicate => + First_Dozen in 1 .. 2 | 3 | 4 | 5 .. 6 | 7 .. 8 | 9 .. 10 | 11 .. 12 + | 13 .. 14; + + function Valid_Response_Code + (Val : RFLX.RFLX_Types.Base_Integer) return Boolean is + (Val in 16#1# | 16#2# | 16#3# | 16#4# | 16#60# | 16#61# | 16#63# | 16#64# + | 16#65# | 16#66# | 16#67# | 16#68# | 16#69# | 16#6A# | 16#6B# | 16#6C# + | 16#7E# | 16#7F#); + +begin + null; +end Main; diff --git a/testsuite/tests/pp/VC19-020/test.sh b/testsuite/tests/pp/VC19-020/test.sh new file mode 100644 index 00000000..b233fbad --- /dev/null +++ b/testsuite/tests/pp/VC19-020/test.sh @@ -0,0 +1,14 @@ +echo "Testing --layout switch" + +echo "1 --layout=default" +gnatpp -P default.gpr main.adb --layout=default --pipe +echo "---------------------------------------------------" +echo "2 --layout=minimal" +gnatpp -P default.gpr main.adb --layout=minimal --pipe +echo "---------------------------------------------------" +echo "3 --layout=tall" +gnatpp -P default.gpr main.adb --layout=tall --pipe +echo "---------------------------------------------------" +echo "4 --layout=compact" +gnatpp -P default.gpr main.adb --layout=compact --pipe + diff --git a/testsuite/tests/pp/VC19-020/test.yaml b/testsuite/tests/pp/VC19-020/test.yaml new file mode 100644 index 00000000..eeea89b4 --- /dev/null +++ b/testsuite/tests/pp/VC19-020/test.yaml @@ -0,0 +1,3 @@ +description: + gnatpp test +driver: shell_script