Raising_External_Exceptions: do not flag internally caught exceptions

Author: thvnx

lkql_checker/share/lkql/raising_external_exceptions.lkql

@@ -1,3 +1,5 @@
+import stdlib
+
 # TODO: share is_predefined_exception with raising_predefined_exception
 fun is_predefined_exception(e) = {
     val name = e.p_defining_name().p_canonical_fully_qualified_name();
@@ -7,9 +9,24 @@ fun is_predefined_exception(e) = {
     name == "standard.tasking_error"
 }
 
+fun internal_catch(n) =
+    |" Return whether the current RaiseStmt is locally caught.
+    n is *(
+        any parent: stmts@HandledStmts
+        when stmts.f_exceptions is *(
+            any children: eh@ExceptionHandler
+            when stdlib.any([
+                ex_name is OthersDesignator
+                or ex_name.p_referenced_decl() == n.f_exception_name.p_referenced_decl()
+                for ex_name in eh.f_handled_exceptions.children
+            ])
+        )
+    )
+
 fun check_raise(n, lib) = {
     val e = n.f_exception_name.p_referenced_decl();
     not (is_predefined_exception(e)
+         or internal_catch(n)
          or e is *(all parent: not PrivatePart,
                    any parent: exc_lib@LibraryItem when exc_lib == lib))
 }

testsuite/tests/checks/raise_external/test.adb

@@ -0,0 +1,57 @@
+package body Test is
+   package body Pack is
+      Exception_2 : exception;
+      Exception_3 : exception;
+      procedure Proc_0 is
+      begin
+         raise Exception_0;
+      end Proc_0;
+      procedure Proc_1 is
+      begin
+         raise Exception_1;
+      end Proc_1;
+      procedure Proc_2 is
+      begin
+         raise Exception_2; -- FLAG
+      end Proc_2;
+      procedure Proc_3 is
+      begin
+         raise Exception_3;
+      exception
+         when Exception_3 =>
+            null;
+      end Proc_3;
+      procedure Proc_4 is
+      begin
+         raise Exception_3;
+      exception
+         when others =>
+            null;
+      end Proc_4;
+   end Pack;
+
+   package body Pack_G is
+      Exception_G2 : exception;
+      Exception_G3 : exception;
+      Exception_G4 : exception;
+      procedure Proc_G0 is
+      begin
+         raise Exception_0;
+      end Proc_G0;
+      procedure Proc_G1 is
+      begin
+         raise Exception_G1;
+      end Proc_G1;
+      procedure Proc_G2 is
+      begin
+         raise Exception_G2; -- FLAG
+      end Proc_G2;
+      procedure Proc_G3 is
+      begin
+         raise Exception_G4;
+      exception
+         when Exception_G3 | Exception_G4 =>
+            null;
+      end Proc_G3;
+   end Pack_G;
+end Test;

testsuite/tests/checks/raise_external/test.ads

@@ -0,0 +1,12 @@
+package Test is
+   Exception_0 : exception;
+   package Pack is
+      Exception_1 : exception;
+      procedure Proc_1;
+   end Pack;
+   generic
+   package Pack_G is
+      Exception_G1 : exception;
+      procedure Proc_G1;
+   end Pack_G;
+end Test;

testsuite/tests/checks/raise_external/test.out

@@ -2,3 +2,11 @@ foo.adb:6:10: rule violation: raised exception is not declared in visible part o
 6 |          raise Exception_Declarations.Ex;   --  FLAG
   |          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
+test.adb:15:10: rule violation: raised exception is not declared in visible part of enclosing library package
+15 |          raise Exception_2; -- FLAG
+   |          ^^^^^^^^^^^^^^^^^^
+
+test.adb:47:10: rule violation: raised exception is not declared in visible part of enclosing library package
+47 |          raise Exception_G2; -- FLAG
+   |          ^^^^^^^^^^^^^^^^^^^
+