From 867af7537b5fa66833d561c1596a165994b79503 Mon Sep 17 00:00:00 2001 From: Joao Azevedo Date: Wed, 13 Nov 2024 12:05:04 +0000 Subject: [PATCH] Adapt GNATpp and GNATmetric to the new ElsePart node For GNATpp: Update the IfStmt and SelectStmt templates, replacing the template for `f_else_stmt` by a required ElsePart node. Add template for the ElsePart node. For GNATmetric: Replace F_Else_Stmts and F_Abort_Stmts by F_Else_Part.F_Stmts and F_Then_Abort_Part.F_Stmts respectively. --- src/metrics-actions.adb | 10 +++++--- src/pp-actions.adb | 25 +++++++------------- testsuite/tests/pp/then_abort_part/a.adb | 5 ++++ testsuite/tests/pp/then_abort_part/test.out | 16 +++++++++++++ testsuite/tests/pp/then_abort_part/test.sh | 1 + testsuite/tests/pp/then_abort_part/test.yaml | 2 ++ 6 files changed, 40 insertions(+), 19 deletions(-) create mode 100644 testsuite/tests/pp/then_abort_part/a.adb create mode 100644 testsuite/tests/pp/then_abort_part/test.out create mode 100644 testsuite/tests/pp/then_abort_part/test.sh create mode 100644 testsuite/tests/pp/then_abort_part/test.yaml diff --git a/src/metrics-actions.adb b/src/metrics-actions.adb index dbf86516..3fab31d2 100644 --- 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 index 4ae5cb2b..3f8a007f 100644 --- 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 new file mode 100644 index 00000000..fbd56cc3 --- /dev/null +++ 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 new file mode 100644 index 00000000..32e2aa3f --- /dev/null +++ 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 new file mode 100644 index 00000000..bfeba605 --- /dev/null +++ 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 new file mode 100644 index 00000000..30fb6074 --- /dev/null +++ b/testsuite/tests/pp/then_abort_part/test.yaml @@ -0,0 +1,2 @@ +description: gnatpp test +driver: shell_script