Skip to content

Commit

Permalink
Merge branch 'topic/VC19-020' into 'master'
Browse files Browse the repository at this point in the history 
VC19-020: Modify Ada_Membership_Expr template

See merge request eng/ide/libadalang-tools!16
  • Loading branch information
@CKMonika
CKMonika committed Jan 9, 2023
2 parents 44fe445 + 9d5a8d8 commit 1493651
Show file tree
Hide file tree
Showing 18 changed files with 232 additions and 98 deletions.
4 changes: 2 additions & 2 deletions src/pp-actions.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down Expand Up @@ -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 ("!"),
Expand Down
6 changes: 3 additions & 3 deletions testsuite/tests/pp/S225-027/in/lal_extensions.ads
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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.

Expand Down
84 changes: 42 additions & 42 deletions testsuite/tests/pp/S225-027/in/metrics-actions.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 & """");
Expand Down Expand Up @@ -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 |
Expand Down Expand Up @@ -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;
Expand All @@ -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))
Expand All @@ -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;
Expand All @@ -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;
Expand Down Expand Up @@ -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 :=
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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;
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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);
Expand All @@ -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;
Expand All @@ -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
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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
Expand All @@ -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) =
Expand Down
2 changes: 1 addition & 1 deletion testsuite/tests/pp/S225-027/in/metrics-line_counting.ads
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down

0 comments on commit 1493651

Please sign in to comment.