Build: enable lots of warnings in development

- We generally build with something like -w +A-29.
- The Jbuilder --dev flag also turns on warnings as errors.
- The --dev flag has its own (currently) hardcoded warning set. We
  override it, because we want a more restrictive set, and for
  future-proofing.
- Fixed some warnings by modifying code.
- The new lwt.ml has received an annotation for disabling warning 4 for
  that file only; this was discussed in #354.

Makefile

@@ -8,22 +8,22 @@ default: build
 # build the usual development packages
 .PHONY: build
 build: check-config
-	jbuilder build --only-packages lwt
+	jbuilder build --dev --only-packages lwt
 
 # build everything, including additional packages
 .PHONY: build-all
 build-all: check-config
-	jbuilder build
+	jbuilder build --dev
 
 # run unit tests for package lwt
 .PHONY: test
 test: check-config
-	jbuilder runtest --only-packages lwt
+	jbuilder runtest --dev --only-packages lwt
 
 # run all unit tests
 .PHONY: test-all
 test-all: check-config
-	jbuilder runtest
+	jbuilder runtest --dev
 
 # configuration
 .PHONY: check-config

src/core/jbuild

@@ -5,4 +5,5 @@
   (public_name lwt)
   (synopsis "Monadic promises and concurrent I/O")
   (wrapped false)
-  (libraries (bytes result))))
+  (libraries (bytes result))
+  (flags (:standard -w +A-29))))

src/core/lwt.ml

@@ -365,6 +365,15 @@
 
 
 
+(* Suppress warning 4, "fragile pattern matching," in this file only, due to
+
+     https://caml.inria.fr/mantis/view.php?id=7451
+
+   This can be removed if/when Lwt requires a minimum OCaml version 4.05. *)
+[@@@ocaml.warning "-4"]
+
+
+
 (* Some sequence-associated storage types
 
    Sequence-associated storage is defined and documented later, in module

src/glib/jbuild

@@ -6,6 +6,7 @@
   (synopsis "GLib integration for Lwt")
   (wrapped false)
   (libraries (lwt lwt.unix))
+  (flags (:standard -w +A))
   (c_names (lwt_glib_stubs))
   (c_flags (:include glib_c_flags.sexp))
   (c_library_flags (:include glib_c_library_flags.sexp))))

src/logger/jbuild

@@ -8,4 +8,5 @@
   (synopsis "Logger for Lwt")
   (optional)
   (wrapped false)
-  (libraries (lwt))))
+  (libraries (lwt))
+  (flags (:standard -w +A))))

src/ppx/jbuild

@@ -10,4 +10,5 @@
               ppx_tools_versioned))
   (ppx_runtime_libraries (lwt))
   (kind ppx_rewriter)
-  (preprocess (pps (ppx_tools_versioned.metaquot_404)))))
+  (preprocess (pps (ppx_tools_versioned.metaquot_404)))
+  (flags (:standard -w +A-4))))

src/preemptive/jbuild

@@ -5,4 +5,5 @@
   (public_name lwt.preemptive)
   (synopsis "Preemptive thread support for Lwt")
   (wrapped false)
-  (libraries (lwt lwt.unix threads))))
+  (libraries (lwt lwt.unix threads))
+  (flags (:standard -w +A))))

src/react/jbuild

@@ -5,4 +5,5 @@
   (public_name lwt_react)
   (synopsis "Reactive programming helpers for Lwt")
   (wrapped false)
-  (libraries (lwt react))))
+  (libraries (lwt react))
+  (flags (:standard -w +A))))

src/ssl/jbuild

@@ -5,4 +5,5 @@
   (public_name lwt_ssl)
   (synopsis "SSL support for Lwt")
   (wrapped false)
-  (libraries (ssl lwt.unix))))
+  (libraries (ssl lwt.unix))
+  (flags (:standard -w +A))))

src/unix/config/discover.ml

@@ -378,7 +378,7 @@ let safe_remove file_name =
   else
     try
       Sys.remove file_name
-    with exn ->
+    with _ ->
       ()
 
 let test_code args stub_code =
@@ -493,7 +493,7 @@ let lib_flags env_var_prefix fallback =
     | x ->
         let opt, lib = fallback () in
         match x with
-          | Some opt, Some lib ->
+          | Some _, Some _ ->
               assert false
           | Some opt, None ->
               (opt, lib)
@@ -543,7 +543,7 @@ let () =
 
   (* read ocamlc -config and lwt config files.
      The former must exist, but we can apply defaults for the later. *)
-  let read_config config filename =
+  let read_config filename =
     let f = open_in filename in
     let cfg line =
       let idx = String.index line ':' in
@@ -564,8 +564,8 @@ let () =
     printf "Configuration file for 'ocamlc -config' does not exist\n";
     exit 1;
   end in
-  let ocamlc_config = read_config "ocamlc" !ocamlc_config in
-  let lwt_config  = try read_config "lwt" !lwt_config with _ -> [] in
+  let ocamlc_config = read_config !ocamlc_config in
+  let lwt_config = try read_config !lwt_config with _ -> [] in
   (* get params from configuration files *)
   let () =
     let get var name =

src/unix/config/jbuild

@@ -1,4 +1,5 @@
 (jbuild_version 1)
 
 (executable
- ((name discover)))
+ ((name discover)
+  (flags (:standard -w +A-29))))

src/unix/jbuild

@@ -92,6 +92,7 @@
   (optional)
   (wrapped false)
   (libraries (lwt lwt.log unix bigarray))
+  (flags (:standard -w +A-29))
   (c_names (
     lwt_unix_stubs
     lwt_libev_stubs

src/unix/stubs/gen_stubs.ml

@@ -339,15 +339,15 @@ module MakeGen(Gen64 : Generator)(Params : Params) = struct
 
   let ins =
     List.filter
-      (fun (_, dir, { caml_type }) ->
+      (fun (_, dir, {caml_type; _}) ->
          (dir = In || dir = In_out) && caml_type <> Caml_void)
       job.params
 
   let strings =
     List.map
       (fun (name, _, _) -> name)
       (List.filter
-         (fun (_, dir, { caml_type }) -> dir = In && caml_type = Caml_string)
+         (fun (_, dir, {caml_type; _}) -> dir = In && caml_type = Caml_string)
          job.params)
 
   let caml_return_type, is_tuple =
@@ -363,8 +363,8 @@ module MakeGen(Gen64 : Generator)(Params : Params) = struct
     String.concat " -> "
       (match
          List.map
-           (fun (_, _, { caml_type }) -> caml_type_name caml_type)
-           (List.filter (fun (_, dir, { caml_type }) -> dir = In && caml_type <> Caml_void) job.params)
+           (fun (_, _, {caml_type; _}) -> caml_type_name caml_type)
+           (List.filter (fun (_, dir, {caml_type; _}) -> dir = In && caml_type <> Caml_void) job.params)
        with
          | [] -> ["unit"]
          | l -> l)
@@ -418,7 +418,7 @@ module MakeGen(Gen64 : Generator)(Params : Params) = struct
            (match strings with
               | [] ->
                   pr "    unix_error(error, %S, Nothing);\n" job.name
-              | name :: _ ->
+              | _name :: _ ->
                   pr "    unix_error(error, %S, string_argument);\n" job.name);
            pr "  }\n");
     if job.result.caml_type <> Caml_void then begin
@@ -477,7 +477,7 @@ module MakeGen(Gen64 : Generator)(Params : Params) = struct
     pr "  job->job.worker = (lwt_unix_job_worker)worker_%s%s;\n" job.name worker_suffix;
     pr "  job->job.result = (lwt_unix_job_result)result_%s%s;\n" job.name result_suffix;
     List.iter
-      (fun (name, dir, { caml_type; c_type; hint }) ->
+      (fun (name, _dir, { caml_type; c_type; hint }) ->
          if caml_type <> Caml_string then begin
            pr "  /* Copy the %s parameter. */\n" name;
            pr "  job->%s = " name;
@@ -545,7 +545,7 @@ module MakeGen(Gen64 : Generator)(Params : Params) = struct
       job.name
       (String.concat ", "
          (List.map
-            (fun (name, dir, { c_type }) ->
+            (fun (name, dir, {c_type; _}) ->
               match dir with
                 | In -> c_type_name c_type ^ " " ^ name
                 | In_out | Out -> c_type_name (C_ptr c_type) ^ " " ^ name)
@@ -589,7 +589,7 @@ module MakeGen(Gen64 : Generator)(Params : Params) = struct
 
     let converters =
       List.filter
-        (fun (name, _, { hint }) -> hint <> Hint_none)
+        (fun (_name, _, {hint; _}) -> hint <> Hint_none)
         job.params
     in
     if converters <> [] then begin
@@ -599,7 +599,7 @@ module MakeGen(Gen64 : Generator)(Params : Params) = struct
    +-----------------------------------------------------------------+ */
 ";
       List.iter
-        (fun (name, _, atype) ->
+        (fun (_name, _, atype) ->
           match atype.hint with
             | Hint_none ->
               ()
@@ -610,7 +610,7 @@ module MakeGen(Gen64 : Generator)(Params : Params) = struct
                   | Caml_variant (name, cstrs) -> (name, cstrs)
                   | _ -> assert false
               in
-              let path, item = split_name name in
+              let _path, item = split_name name in
               pr "\n";
               pr "/* Table mapping constructors of ocaml type %s to C values. */\n" name;
               pr "static %s %s_table[] = {\n" (c_type_name atype.c_type) item;
@@ -673,7 +673,7 @@ module MakeGen(Gen64 : Generator)(Params : Params) = struct
       pr "  int errno_copy;\n"
     end;
     List.iter
-      (fun (name, dir, { c_type }) ->
+      (fun (name, dir, {c_type; _}) ->
         pr "  /* %s parameter. */\n" (string_of_direction dir);
         pr "  %s %s;\n" (c_type_name c_type) name)
       job.params;
@@ -801,13 +801,13 @@ end
         fprintf !ml_oc "\
 module Make(Job : Job) = struct
 ";
-        StringMap.iter (fun name job -> gen job) jobs;
+        StringMap.iter (fun _name job -> gen job) jobs;
         output_string !ml_oc "end\n";
         close_out !ml_oc
     | [|_; "list-job-files"|] ->
-        StringMap.iter (fun name job -> printf "lwt_unix_job_%s.c\n" name) jobs
+        StringMap.iter (fun name _job -> printf "lwt_unix_job_%s.c\n" name) jobs
     | [|_; "list-job-names"|] ->
-        StringMap.iter (fun name job -> printf "%s\n" name) jobs
+        StringMap.iter (fun name _job -> printf "%s\n" name) jobs
     | _ ->
         log "invalid arguments";
         eprintf "usage: %s [list-job-files|list-job-names]\n" prog_name;

src/unix/stubs/jbuild

@@ -1,4 +1,5 @@
 (jbuild_version 1)
 
 (executable
- ((name gen_stubs)))
+ ((name gen_stubs)
+  (flags (:standard -w +A-4-29))))

test/core/test_lwt_list.ml

@@ -27,7 +27,7 @@ let ( <=> ) v v' =
   assert ( state v = v')
 
 let test_exn f v e =
-  assert ( try f v;assert false with exn -> exn = e)
+  assert ( try ignore (f v);assert false with exn -> exn = e)
 
 exception Exn
 
@@ -252,7 +252,7 @@ let suite = suite "lwt_list" [
         fun () ->
           let l = [1;3] in
           catch
-            (fun () -> Lwt_list.find_s (fun n -> return ((n mod 2) = 0)) l >>= fun result ->
+            (fun () -> Lwt_list.find_s (fun n -> return ((n mod 2) = 0)) l >>= fun _result ->
               return false)
             (function
               | Not_found -> return true