Add type annotation to ignored values

Julow · Julow · commit e396a1a30167 · 2025-04-22T18:03:21.000+02:00
This helps find ignored Lwt threads, which are a challenge to translate
into direct-style concurrency.
diff --git a/src/baselib/ocsigen_cache.ml b/src/baselib/ocsigen_cache.ml
@@ -291,7 +291,7 @@ end = struct
       | Some n when node == n -> ()
       | _ ->
           remove' node l;
-          ignore (add_node node l))
+          ignore (add_node node l : _ node option))
 
   (* assertion: = None *)
   (* we must not change the physical address => use add_node *)
@@ -440,7 +440,7 @@ functor
 
     let remove cache k =
       try
-        let _v, node = H.find cache.table k in
+        let (_v : A.value), node = H.find cache.table k in
         assert (
           match Dlist.list_of node with
           | None -> false
@@ -451,7 +451,7 @@ functor
     (* Add in a cache, under the hypothesis that the value is
        not already in the cache *)
     let add_no_remove cache k v =
-      ignore (Dlist.add k cache.pointers);
+      ignore (Dlist.add k cache.pointers : A.key option);
       match Dlist.newest cache.pointers with
       | None -> assert false
       | Some n -> H.add cache.table k (v, n)
@@ -465,7 +465,7 @@ functor
         cache.finder k >>= fun r ->
         (try
            (* it may have been added during cache.finder *)
-           ignore (find_in_cache cache k)
+           ignore (find_in_cache cache k : A.value)
          with Not_found -> add_no_remove cache k r);
         Lwt.return r
 
diff --git a/src/baselib/ocsigen_lib.ml b/src/baselib/ocsigen_lib.ml
@@ -130,11 +130,11 @@ module Netstring_pcre = struct
 
   let matched_group result n _ =
     if n < 0 || n >= Re.Group.nb_groups result then raise Not_found;
-    ignore (Pcre.get_substring_ofs result n);
+    ignore (Pcre.get_substring_ofs result n : int * int);
     Pcre.get_substring result n
 
   let matched_string result _ =
-    ignore (Pcre.get_substring_ofs result 0);
+    ignore (Pcre.get_substring_ofs result 0 : int * int);
     Pcre.get_substring result 0
 
   let global_replace pat templ s = Re.replace pat ~f:(tr_templ templ) s
@@ -427,7 +427,9 @@ module Url = struct
       https, host, port, uri_string, path, query, get_params
 
   let prefix_and_path_of_t url =
-    let https, host, port, _, path, _, _ = parse url in
+    let https, host, port, (_ : uri), path, (_ : uri option), (_ : _ Lazy.t) =
+      parse url
+    in
     let https_str =
       match https with
       | None -> ""
diff --git a/src/baselib/ocsigen_stream.ml b/src/baselib/ocsigen_stream.ml
@@ -189,7 +189,9 @@ let substream delim s =
           then enlarge_stream stre >>= aux
           else
             try
-              let p, _ = Ocsigen_lib.Netstring_pcre.search_forward rdelim s 0 in
+              let p, (_ : Re.Group.t) =
+                Ocsigen_lib.Netstring_pcre.search_forward rdelim s 0
+              in
               cont (String.sub s 0 p) (fun () ->
                 empty
                   (Some
diff --git a/src/baselib/tests/test_wrapping.ml b/src/baselib/tests/test_wrapping.ml
@@ -1,5 +1,5 @@
 (* ocamlfind ocamlopt -linkpkg -package react -g -I ../ ../wrapping.cmxa test_wrapping.ml -o test_wrapping *)
-let _ = Printexc.record_backtrace true
+let () = Printexc.record_backtrace true
 
 (*** simple wrap test ***)
 
diff --git a/src/extensions/accesscontrol.ml b/src/extensions/accesscontrol.ml
@@ -280,7 +280,7 @@ let parse_config parse_fun = function
         | Element ("then", [], ithen) :: q -> parse_fun ithen, q
         | _ -> Ocsigen_extensions.badconfig "Bad <then> branch in <if>"
       in
-      let ielse, _sub =
+      let ielse, (_sub : _ list) =
         match sub with
         | Element ("else", [], ielse) :: ([] as q) -> parse_fun ielse, q
         | [] -> parse_fun [], []
diff --git a/src/extensions/authbasic.ml b/src/extensions/authbasic.ml
@@ -42,7 +42,7 @@ let register_basic_authentication_method, get_basic_authentication_method =
     fun config -> !fun_auth config )
 
 (* Basic authentication with a predefined login/password (example) *)
-let _ =
+let () =
   let open Xml in
   register_basic_authentication_method @@ function
   | Element ("plain", [("login", login); ("password", password)], _) ->
diff --git a/src/extensions/deflatemod.ml b/src/extensions/deflatemod.ml
@@ -86,7 +86,7 @@ let rec output oz f buf pos len =
   else if len = 0
   then next_cont oz f
   else
-    let _, used_in, used_out =
+    let (_ : bool), used_in, used_out =
       try
         Zlib.deflate oz.stream
           (Bytes.unsafe_of_string buf)
@@ -133,7 +133,7 @@ and next_cont oz stream =
         else
           (* no more input, deflates only what were left because output buffer
            * was full *)
-          let finished, _, used_out =
+          let finished, (_ : int), used_out =
             Zlib.deflate oz.stream oz.buf 0 0 oz.buf oz.pos oz.avail
               Zlib.Z_FINISH
           in
diff --git a/src/extensions/extendconfiguration.ml b/src/extensions/extendconfiguration.ml
@@ -59,7 +59,7 @@ let check_regexp_list =
   try Hashtbl.find hashtbl r
   with Not_found -> (
     try
-      ignore (Ocsigen_lib.Netstring_pcre.regexp r);
+      ignore (Ocsigen_lib.Netstring_pcre.regexp r : Re.re);
       Hashtbl.add hashtbl r ()
     with _ -> raise (Bad_regexp r))
 
diff --git a/src/extensions/staticmod.ml b/src/extensions/staticmod.ml
@@ -59,7 +59,9 @@ let correct_user_local_file =
   let regexp = Ocsigen_lib.Netstring_pcre.regexp "(/\\.\\./)|(/\\.\\.$)" in
   fun path ->
     try
-      ignore (Ocsigen_lib.Netstring_pcre.search_forward regexp path 0);
+      ignore
+        (Ocsigen_lib.Netstring_pcre.search_forward regexp path 0
+         : int * Pcre.substrings);
       false
     with Not_found -> true
 
diff --git a/src/server/ocsigen_cohttp.ml b/src/server/ocsigen_cohttp.ml
@@ -204,7 +204,7 @@ let shutdown timeout =
     | Some f -> fun () -> Lwt_unix.sleep f
     | None -> fun () -> Lwt.return ()
   in
-  ignore (Lwt.pick [process (); stop] >>= fun () -> exit 0)
+  ignore (Lwt.pick [process (); stop] >>= fun () -> exit 0 : unit Lwt.t)
 
 let service ?ssl ~address ~port ~connector () =
   let tls_own_key =
diff --git a/src/server/ocsigen_extensions.ml b/src/server/ocsigen_extensions.ml
@@ -636,12 +636,12 @@ module Configuration = struct
     raise (Error_in_user_config_file ("No PCDATA allowed in tag " ^ in_tag))
 
   let check_attribute_occurrence ~in_tag attributes = function
-    | name, {attribute_obligatory = true; _} -> (
-      try ignore (List.assoc name attributes)
-      with Not_found ->
-        raise
-          (Error_in_user_config_file
-             ("Obligatory attribute " ^ name ^ " not in tag " ^ in_tag)))
+    | name, {attribute_obligatory = true; _} ->
+        if not (List.mem_assoc name attributes)
+        then
+          raise
+            (Error_in_user_config_file
+               ("Obligatory attribute " ^ name ^ " not in tag " ^ in_tag))
     | _ -> ()
 
   let check_element_occurrence ~in_tag elements = function
diff --git a/src/server/ocsigen_local_files.ml b/src/server/ocsigen_local_files.ml
@@ -100,7 +100,9 @@ let check_dotdot =
        In URLs, .. have already been removed by the server,
        but the filename may come from somewhere else than URLs ... *)
     try
-      ignore (Ocsigen_lib.Netstring_pcre.search_forward regexp filename 0);
+      ignore
+        (Ocsigen_lib.Netstring_pcre.search_forward regexp filename 0
+         : int * Re.Group.t);
       false
     with Not_found -> true
 
diff --git a/src/server/ocsigen_multipart.ml b/src/server/ocsigen_multipart.ml
@@ -86,7 +86,9 @@ let read_header ?downcase ?unfold ?strip s =
   in
   find_end_of_header s >>= fun (s, end_pos) ->
   let b = Ocsigen_stream.current_buffer s in
-  let h, _ = scan_header ?downcase ?unfold ?strip b ~start_pos:0 ~end_pos in
+  let h, (_ : int) =
+    scan_header ?downcase ?unfold ?strip b ~start_pos:0 ~end_pos
+  in
   Ocsigen_stream.skip s (Int64.of_int end_pos) >>= fun s -> Lwt.return (s, h)
 
 let lf_re = S.regexp "[\n]"
@@ -239,7 +241,7 @@ let counter =
     !c
 
 let field field content_disp =
-  let _, res =
+  let (_ : int), res =
     S.search_forward (S.regexp (field ^ "=.([^\"]*).;?")) content_disp 0
   in
   S.matched_group res 1 content_disp
diff --git a/src/server/ocsigen_server.ml b/src/server/ocsigen_server.ml
@@ -24,14 +24,14 @@ let () = Random.self_init ()
 
 (* Without the following line, it stops with "Broken Pipe" without
    raising an exception ... *)
-let _ = Sys.set_signal Sys.sigpipe Sys.Signal_ignore
+let () = Sys.set_signal Sys.sigpipe Sys.Signal_ignore
 
 (* Exit gracefully on SIGINT so that profiling will work *)
-let _ = Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> exit 0))
+let () = Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> exit 0))
 let section = Lwt_log.Section.make "ocsigen:main"
 
 (* Initialize exception handler for Lwt timeouts: *)
-let _ =
+let () =
   Lwt_timeout.set_exn_handler (fun e ->
     Lwt_log.ign_error ~section ~exn:e "Uncaught Exception after lwt timeout")
 
@@ -97,7 +97,7 @@ let reload ?file () =
    with e -> Lwt_log.ign_error ~section (fst (errmsg e)));
   Lwt_log.ign_warning ~section "Config file reloaded"
 
-let _ =
+let () =
   let f _s = function
     | ["reopen_logs"] ->
         Ocsigen_messages.open_files () >>= fun () ->
@@ -248,13 +248,13 @@ let main config =
       let commandpipe = Ocsigen_config.get_command_pipe () in
       let with_commandpipe =
         try
-          ignore (Unix.stat commandpipe);
+          ignore (Unix.stat commandpipe : Unix.stats);
           true
         with Unix.Unix_error _ -> (
           try
             let umask = Unix.umask 0 in
             Unix.mkfifo commandpipe 0o660;
-            ignore (Unix.umask umask);
+            ignore (Unix.umask umask : int);
             Lwt_log.ign_warning ~section "Command pipe created";
             true
           with e ->
@@ -270,9 +270,8 @@ let main config =
         raise
           (Ocsigen_config.Config_file_error
              "maxthreads should be greater than minthreads");
-      ignore
-        (Lwt_preemptive.init minthreads maxthreads (fun s ->
-           Lwt_log.ign_error ~section s));
+      Lwt_preemptive.init minthreads maxthreads (fun s ->
+        Lwt_log.ign_error ~section s);
       (Lwt.async_exception_hook :=
          fun e ->
            (* replace the default "exit 2" behaviour *)
@@ -291,7 +290,7 @@ let main config =
         Unix.close devnull;
         Unix.close Unix.stdin);
       (* detach from the terminal *)
-      if Ocsigen_config.get_daemon () then ignore (Unix.setsid ());
+      if Ocsigen_config.get_daemon () then ignore (Unix.setsid () : int);
       Ocsigen_extensions.end_initialisation ();
       (if with_commandpipe
        then
@@ -325,7 +324,7 @@ let main config =
                    Lwt.fail e)
            >>= f
          in
-         ignore (f ()));
+         ignore (f () : 'a Lwt.t));
       Lwt_main.run
       @@ Lwt.join
            (List.map
@@ -369,7 +368,7 @@ let main config =
           let f =
             Unix.openfile p [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o640
           in
-          ignore (Unix.write_substring f spid 0 len);
+          ignore (Unix.write_substring f spid 0 len : int);
           Unix.close f
     in
     (* set_passwd_if_needed sslinfo; *)
