explicit error for while condition

Author: zth

compiler/ml/error_message_utils.ml

@@ -80,6 +80,7 @@ type type_clash_context =
   | TryReturn
   | StringConcat
   | ComparisonOperator
+  | WhileCondition
   | MathOperator of {
       for_float: bool;
       operator: string;
@@ -110,6 +111,8 @@ let error_expected_type_text ppf type_clash_context =
     fprintf ppf "But it's being compared to something of type:"
   | Some SwitchReturn -> fprintf ppf "But this switch is expected to return:"
   | Some TryReturn -> fprintf ppf "But this try/catch is expected to return:"
+  | Some WhileCondition ->
+    fprintf ppf "But a @{<info>while@} loop condition must always be of type:"
   | Some IfCondition ->
     fprintf ppf "But @{<info>if@} conditions must always be of type:"
   | Some IfReturn ->

compiler/ml/typecore.ml

@@ -1884,7 +1884,6 @@ let rec approx_type env sty =
   | Ptyp_poly (_, sty) -> approx_type env sty
   | _ -> newvar ()
 
-(* TODO: Needs type clash context? *)
 let rec type_approx env sexp =
   match sexp.pexp_desc with
   | Pexp_let (_, _, e) -> type_approx env e
@@ -2846,8 +2845,7 @@ and type_expect_ ~context ?in_function ?(recarg = Rejected) env sexp ty_expected
       }
   | Pexp_while (scond, sbody) ->
     let cond =
-      (* TODO: Add explicit WhileCondition *)
-      type_expect ~context:(Some IfCondition) env scond Predef.type_bool
+      type_expect ~context:(Some WhileCondition) env scond Predef.type_bool
     in
     let body = type_statement ~context:None env sbody in
     rue
@@ -3899,7 +3897,6 @@ and type_cases ~(call_context : [`Switch | `Function | `Try]) ?in_function env
           match pc_guard with
           | None -> None
           | Some scond ->
-            (* TODO: Add explicit SwitchIfCondition *)
             Some
               (type_expect ~context:(Some IfCondition) ext_env
                  (wrap_unpacks scond unpacks)

tests/build_tests/super_errors/expected/while_condition.res.expected

@@ -0,0 +1,10 @@
+
+  We've found a bug for you!
+  /.../fixtures/while_condition.res:1:7-13
+
+  1 │ while "horse" {
+  2 │   Console.log("What")
+  3 │ }
+
+  This has type: string
+  But a while loop condition must always be of type: bool

tests/build_tests/super_errors/fixtures/while_condition.res

@@ -0,0 +1,3 @@
+while "horse" {
+  Console.log("What")
+}