Don't warn about unreachable code for a finally block that always throws (#9204)

Give a finally block that always throws no unreachable-code warning

Why:
    The finally block is typed as a statement, and a statement of type 'a
    reports warning 21, although no code follows a throw that ends the
    finally block. Code that follows it inside the block still warns.

Diagnostic removed (warning 21 for a throwing finally block):
Example:
    exception B
    let k = () => try { 1 } finally { throw(B) }
Before (diagnostic):
    Warning number 21
    2:35-42
    This statement does not continue execution; following code is unreachable.
After (diagnostic): no warning

Review: Does `{ throw(B); Console.log(2) }` in a finally block still warn? Yes, the sequence types `throw(B)` as an ordinary statement.


Claude-Session: https://claude.ai/code/session_01Kbf3gGhHjzBTXqSo8Dckpb

Signed-off-by: Christoph Knittel <ck@cca.io>
Co-authored-by: Claude Opus 5.5 <noreply@anthropic.com>

Author: cknitt

compiler/ml/typecore.ml

@@ -2914,12 +2914,15 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected)
     in
     (* JavaScript runs the finally block after the body or catch has already
        decided how the try is left, so a break or continue there would cancel
-       a pending exception or result. *)
+       a pending exception or result. A finally block that always throws ends
+       the try with no code after it, so it gets no nonreturning-statement
+       warning. *)
     let finally =
       Option.map
         (fun sfinally ->
           with_control_flow_boundary ~in_finally:true (fun () ->
-              type_statement ~context:None env sfinally))
+              type_statement ~nonreturning_warning:false ~context:None env
+                sfinally))
         sfinally
     in
     re
@@ -4767,13 +4770,13 @@ and type_construct ~context env loc lid sargs ty_expected attrs =
 
 (* Typing of statements (expressions whose values are discarded) *)
 
-and type_statement ~context env sexp =
+and type_statement ?(nonreturning_warning = true) ~context env sexp =
   let loc = (final_subexpression sexp).pexp_loc in
   begin_def ();
   let exp = type_exp ~context env sexp in
   end_def ();
   let ty = expand_head env exp.exp_type and tv = newvar () in
-  if is_Tvar ty && ty.level > tv.level then
+  if nonreturning_warning && is_Tvar ty && ty.level > tv.level then
     Location.prerr_warning loc Warnings.Nonreturning_statement;
   let expected_ty = instance_def (Predef.type_unit ()) in
   let context = type_clash_context_in_statement sexp in

tests/build_tests/super_errors/expected/finally_nonreturning_statement.res.expected

@@ -0,0 +1,11 @@
+
+  Warning number 21
+  /.../fixtures/finally_nonreturning_statement.res:47:5-12
+
+  45 ┆   1
+  46 ┆ } finally {
+  47 ┆   throw(B)
+  48 ┆   Console.log(2)
+  49 ┆ }
+
+  This statement does not continue execution; following code is unreachable.

tests/build_tests/super_errors/fixtures/finally_nonreturning_statement.res

@@ -0,0 +1,49 @@
+exception B
+
+let rec loop = () => loop()
+
+let throwInFinally = () =>
+  try {
+    1
+  } finally {
+    throw(B)
+  }
+
+let throwAfterStatementInFinally = () =>
+  try {
+    1
+  } finally {
+    Console.log(1)
+    throw(B)
+  }
+
+let throwInFinallyAfterCatch = () =>
+  try {
+    1
+  } catch {
+  | B => 2
+  } finally {
+    throw(B)
+  }
+
+let assertFalseInFinally = () =>
+  try {
+    1
+  } finally {
+    assert(false)
+  }
+
+let nonreturningCallInFinally = () =>
+  try {
+    1
+  } finally {
+    loop()
+  }
+
+let unreachableCodeInFinally = () =>
+  try {
+    1
+  } finally {
+    throw(B)
+    Console.log(2)
+  }