Merge branch 'mr/langkit_863' into 'master'

Adapt GNATpp and GNATmetric to the new ElsePart node See merge request eng/ide/libadalang-tools!262
AdaCore · Nov 14, 2024 · 191934e · 191934e
2 parents 1014b10 + 867af75
commit 191934e
Show file tree

Hide file tree

Showing 6 changed files with 40 additions and 19 deletions.
diff --git a/src/metrics-actions.adb b/src/metrics-actions.adb
@@ -2,7 +2,7 @@
 --                                                                          --
 --                             Libadalang Tools                             --
 --                                                                          --
---                    Copyright (C) 2021-2022, AdaCore                      --
+--                    Copyright (C) 2021-2024, AdaCore                      --
 --                                                                          --
 -- Libadalang Tools  is free software; you can redistribute it and/or modi- --
 -- fy  it  under  terms of the  GNU General Public License  as published by --
@@ -2999,9 +2999,13 @@ package body METRICS.Actions is
                   Num_Alts : constant Metric_Nat :=
                      Children_Count (F_Guards (S));
                   Num_Else : constant Metric_Nat :=
-                    (if Children_Count (F_Else_Stmts (S)) = 0 then 0 else 1);
+                    (if Children_Count (F_Stmts (F_Else_Part (S))) = 0
+                     then 0
+                     else 1);
                   Num_Abort : constant Metric_Nat :=
-                    (if Children_Count (F_Abort_Stmts (S)) = 0 then 0 else 1);
+                    (if Children_Count (F_Stmts (F_Then_Abort_Part (S))) = 0
+                     then 0
+                     else 1);
                begin
                   Inc_Cyc (Complexity_Statement,
                            By => Num_Alts + Num_Else + Num_Abort - 1);

diff --git a/src/pp-actions.adb b/src/pp-actions.adb
@@ -710,9 +710,6 @@ package body Pp.Actions is
    function L (T1, T2, T3, T4 : Str_Template) return Str_Template_Ptr;
    function L (T1, T2, T3, T4, T5 : Str_Template) return Str_Template_Ptr;
    function L (T1, T2, T3, T4, T5, T6 : Str_Template) return Str_Template_Ptr;
-   function L
-     (T1, T2, T3, T4, T5, T6, T7 : Str_Template)
-      return                       Str_Template_Ptr;
    --  All the L functions form a template by concatenating together a bunch of
    --  lines.
 
@@ -755,14 +752,6 @@ package body Pp.Actions is
       return new Str_Template'(T1 & T2 & T3 & T4 & T5 & T6);
    end L;
 
-   function L
-     (T1, T2, T3, T4, T5, T6, T7 : Str_Template)
-      return                       Str_Template_Ptr
-   is
-   begin
-      return new Str_Template'(T1 & T2 & T3 & T4 & T5 & T6 & T7);
-   end L;
-
    function Template_For_Kind (Kind : Ada_Tree_Kind) return Str_Template_Ptr is
    begin
       return
@@ -1109,10 +1098,12 @@ package body Pp.Actions is
            when Ada_Select_Stmt =>
              L ("select",
                 "!",
-                "?else$", "{~$~$}~",
-                "?then abort$", "{~$~$}~",
+                "!",
+                "!",
                 "end select;"),
            when Ada_Select_When_Part => null,
+           when Ada_Then_Abort_Part =>
+             L ("$then abort$", "?{~$~}$~"),
            when Ada_Accept_Stmt =>
              L ("accept !? #(~~)~?~~~;"),
            when Ada_Accept_Stmt_With_Stmts =>
@@ -1145,11 +1136,12 @@ package body Pp.Actions is
              L ("if[ !]# then$",
                 "{?~$~$~}",
                 "?~~~",
-                "?else$",
-                "{~$~$}~",
+                "!",
                 "end if;"),
            when Ada_Elsif_Stmt_Part =>
              L ("elsif[ !]# then$", "{?~$~$~}"),
+           when Ada_Else_Part =>
+             L ("$else$", "{?~$~$}~"),
            when Ada_Named_Stmt =>
              L ("! :$!"),
            when Ada_Named_Stmt_Decl =>
@@ -2512,7 +2504,8 @@ package body Pp.Actions is
 
                              Ada_Case_Stmt_Alternative |
                              Ada_Case_Expr_Alternative |
-                             Ada_Variant
+                             Ada_Variant |
+                             Ada_Then_Abort_Part
                            then
                               null;
                            else

diff --git a/testsuite/tests/pp/then_abort_part/a.adb b/testsuite/tests/pp/then_abort_part/a.adb
@@ -0,0 +1,5 @@
+procedure A is
+begin
+   select when T => null; then abort null; end select;
+   select when T => null; then abort end select;
+end A;
diff --git a/testsuite/tests/pp/then_abort_part/test.out b/testsuite/tests/pp/then_abort_part/test.out
@@ -0,0 +1,16 @@
+
+Info: AdaCore provides a new formatter GNATformat, currently in beta. This will supersede GNATpp when leaving the beta program.
+-----
+
+procedure A is
+begin
+   select when T =>
+      null;
+   then abort
+      null;
+   end select;
+   select when T =>
+      null;
+   then abort
+   end select;
+end A;
diff --git a/testsuite/tests/pp/then_abort_part/test.sh b/testsuite/tests/pp/then_abort_part/test.sh
@@ -0,0 +1 @@
+gnatpp --pipe a.adb
diff --git a/testsuite/tests/pp/then_abort_part/test.yaml b/testsuite/tests/pp/then_abort_part/test.yaml
@@ -0,0 +1,2 @@
+description: gnatpp test
+driver: shell_script