Merge branch 'mr/thevenoux-langkit-query-language#541' into 'master'

Improve Silent_Exception_Handlers to support access-to-subprograms

Closes #541

See merge request eng/libadalang/langkit-query-language!533

Author: thvnx

lkql_checker/share/lkql/silent_exception_handlers.lkql

@@ -1,6 +1,18 @@
 import stdlib
 import control_flow
 
+
+fun qualified_name(name) = {
+    |" Return the fully qualified name of ``name``. This function handles
+    |" access-to-subprogram calls.
+    val name = match name
+    | ce@CallExpr => ce.f_name
+    | ed@ExplicitDeref => ed.f_prefix
+    | * => name;
+
+    name.p_referenced_defining_name().p_canonical_fully_qualified_name()
+}
+
 @check(message="silent exception handler",
        category="Style", subcategory="Programming Practice",
        auto_fix=(n, ctx) => ctx.add_last(n.f_stmts, new RaiseStmt(null, null)))
@@ -72,9 +84,9 @@ fun silent_exception_handlers(node, subprograms=[], subprogram_regexps=[]) =
     {
         fun is_raise_or_log(stmt) =
             stmt is (RaiseStmt
-            | n@BaseId(p_is_call(): true)
+            | n@Name(p_is_call(): true)
                 when n.p_referenced_decl() is decl@BasicDecl
-                    when match decl.p_canonical_fully_qualified_name()
+                    when match qualified_name(n)
                     | "^ada.exceptions.(raise_exception|reraise_occurrence)$" => true
                     | n => [s for s in subprograms if n == s] or
                             [r for r in subprogram_regexps

testsuite/tests/checks/silent_exception_handlers_deref/main.adb

@@ -0,0 +1,50 @@
+procedure Main is
+   --  Implicit deref case
+
+   type Proc_Access is access procedure (I : Integer);
+
+   procedure Test (A, B : Proc_Access) is
+   begin
+      --  Implicit deref cases
+      begin
+         null;
+      exception
+         when Program_Error => A (1); --  FLAG
+         when others        => B (1); --  NO FLAG
+      end;
+
+      --  Explicit deref cases
+      begin
+         null;
+      exception
+         when Program_Error => A.all (1); --  FLAG
+         when others        => B.all (1); --  NO FLAG
+      end;
+   end Test;
+
+   package P is
+      type T is tagged null record;
+
+      procedure P (A : T);
+
+      type T_Access is access function return T;
+   end P;
+
+   package body P is
+      procedure P (A : T) is null;
+
+      procedure Test (X, Y : T_Access) is
+      begin
+         --  Explicit deref in dotted call cases
+         begin
+            null;
+         exception
+            when Program_Error    => X.all.P; --  FLAG
+            when others           => Y.all.P; --  NO FLAG
+         end;
+      end Test;
+   end P;
+
+begin
+   null;
+end Main;

testsuite/tests/checks/silent_exception_handlers_deref/prj.gpr

@@ -0,0 +1,2 @@
+project Prj is
+end Prj;

testsuite/tests/checks/silent_exception_handlers_deref/test.out

@@ -0,0 +1,12 @@
+main.adb:12:10: rule violation: silent exception handler
+12 |          when Program_Error => A (1); --  FLAG
+   |          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+main.adb:20:10: rule violation: silent exception handler
+20 |          when Program_Error => A.all (1); --  FLAG
+   |          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+main.adb:42:13: rule violation: silent exception handler
+42 |             when Program_Error    => X.all.P; --  FLAG
+   |             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+

testsuite/tests/checks/silent_exception_handlers_deref/test.yaml

@@ -0,0 +1,9 @@
+driver: 'checker'
+description: |
+    Check that the Silent_Exception_Handles rule handles calls resulting of an
+    access dereference.
+rule_name: silent_exception_handlers
+project: prj.gpr
+rule_arguments:
+   silent_exception_handlers.subprograms: '["main.test.b"]'
+   silent_exception_handlers.subprogram_regexps: '["\.[Y]$"]'