Turn warning 31 (Module_linked_twice) into a hard error (#11635)

.depend

@@ -1956,7 +1956,6 @@ bytecomp/bytelibrarian.cmx : \
     bytecomp/bytelibrarian.cmi
 bytecomp/bytelibrarian.cmi :
 bytecomp/bytelink.cmo : \
-    utils/warnings.cmi \
     bytecomp/symtable.cmi \
     bytecomp/opcodes.cmi \
     utils/misc.cmi \
@@ -1974,7 +1973,6 @@ bytecomp/bytelink.cmo : \
     bytecomp/bytesections.cmi \
     bytecomp/bytelink.cmi
 bytecomp/bytelink.cmx : \
-    utils/warnings.cmx \
     bytecomp/symtable.cmx \
     bytecomp/opcodes.cmx \
     utils/misc.cmx \

Changes

@@ -219,6 +219,9 @@ Working version
   modules with mismatching -for-pack
   (Pierre Chambart and Vincent Laviron, review by Mark Shinwell)
 
+- #11635, #5461, #10564: Turn warning 31 (Module_linked_twice) into a hard error
+  (Hugo Heuzard, review by Valentin Gatien-Baron and Gabriel Scherer)
+
 - #11646: Add colors to error message hints.
   (Christiana Anthony, review by Florian Angeletti)
 

asmcomp/asmlink.ml

@@ -48,16 +48,18 @@ let implementations_defined = ref ([] : (string * string) list)
 let cmx_required = ref ([] : string list)
 
 let check_consistency file_name unit crc =
+  begin try
+    let source = List.assoc unit.ui_name !implementations_defined in
+    raise (Error(Multiple_definition(unit.ui_name, file_name, source)))
+  with Not_found -> ()
+  end;
   begin try
     List.iter
       (fun (name, crco) ->
         interfaces := name :: !interfaces;
         match crco with
           None -> ()
-        | Some crc ->
-            if name = unit.ui_name
-            then Cmi_consistbl.set crc_interfaces name crc file_name
-            else Cmi_consistbl.check crc_interfaces name crc file_name)
+        | Some crc -> Cmi_consistbl.check crc_interfaces name crc file_name)
       unit.ui_imports_cmi
   with Cmi_consistbl.Inconsistency {
       unit_name = name;
@@ -84,13 +86,8 @@ let check_consistency file_name unit crc =
     } ->
     raise(Error(Inconsistent_implementation(name, user, auth)))
   end;
-  begin try
-    let source = List.assoc unit.ui_name !implementations_defined in
-    raise (Error(Multiple_definition(unit.ui_name, file_name, source)))
-  with Not_found -> ()
-  end;
   implementations := unit.ui_name :: !implementations;
-  Cmx_consistbl.set crc_implementations unit.ui_name crc file_name;
+  Cmx_consistbl.check crc_implementations unit.ui_name crc file_name;
   implementations_defined :=
     (unit.ui_name, file_name) :: !implementations_defined;
   if unit.ui_symbol <> unit.ui_name then

bytecomp/bytelink.ml

@@ -31,6 +31,7 @@ type error =
   | Required_module_unavailable of modname * modname
   | Camlheader of string * filepath
   | Wrong_link_order of (modname * modname) list
+  | Multiple_definition of modname * filepath * filepath
 
 exception Error of error
 
@@ -174,16 +175,18 @@ let interfaces = ref ([] : string list)
 let implementations_defined = ref ([] : (string * string) list)
 
 let check_consistency file_name cu =
+  begin try
+    let source = List.assoc cu.cu_name !implementations_defined in
+    raise (Error (Multiple_definition(cu.cu_name, file_name, source)));
+  with Not_found -> ()
+  end;
   begin try
     List.iter
       (fun (name, crco) ->
         interfaces := name :: !interfaces;
         match crco with
           None -> ()
-        | Some crc ->
-            if name = cu.cu_name
-            then Consistbl.set crc_interfaces name crc file_name
-            else Consistbl.check crc_interfaces name crc file_name)
+        | Some crc -> Consistbl.check crc_interfaces name crc file_name)
       cu.cu_imports
   with Consistbl.Inconsistency {
       unit_name = name;
@@ -192,14 +195,6 @@ let check_consistency file_name cu =
     } ->
     raise(Error(Inconsistent_import(name, user, auth)))
   end;
-  begin try
-    let source = List.assoc cu.cu_name !implementations_defined in
-    Location.prerr_warning (Location.in_file file_name)
-      (Warnings.Module_linked_twice(cu.cu_name,
-                                    Location.show_filename file_name,
-                                    Location.show_filename source))
-  with Not_found -> ()
-  end;
   implementations_defined :=
     (cu.cu_name, file_name) :: !implementations_defined
 
@@ -780,6 +775,13 @@ let report_error ppf = function
       in
       fprintf ppf "@[<hov 2>Wrong link order: %a@]"
         (pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ",@ ") depends_on) l
+  | Multiple_definition(modname, file1, file2) ->
+      fprintf ppf
+        "@[<hov>Files %a@ and %a@ both define a module named %s@]"
+        Location.print_filename file1
+        Location.print_filename file2
+        modname
+
 
 let () =
   Location.register_error_of_exn

bytecomp/bytelink.mli

@@ -36,6 +36,7 @@ type error =
   | Required_module_unavailable of modname * modname
   | Camlheader of string * filepath
   | Wrong_link_order of (modname * modname) list
+  | Multiple_definition of modname * filepath * filepath
 
 exception Error of error
 

man/ocamlc.1

@@ -1210,8 +1210,8 @@ compiling your program with later versions of OCaml when they add new
 warnings or modify existing warnings.
 
 The default setting is
-.B \-warn\-error \-a+31
-(only warning 31 is fatal).
+.B \-warn\-error \-a
+(no warning is fatal).
 .TP
 .B \-warn\-help
 Show the description of all available warning numbers.

man/ocamlopt.1

@@ -710,8 +710,8 @@ compiling your program with later versions of OCaml when they add new
 warnings or modify existing warnings.
 
 The default setting is
-.B \-warn\-error \-a+31
-(only warning 31 is fatal).
+.B \-warn\-error \-a
+(no warning is fatal).
 .TP
 .B \-warn\-help
 Show the description of all available warning numbers.

manual/src/cmds/unified-options.etex

@@ -848,7 +848,7 @@ arguments to "-warn-error"
 in production code, because this can break your build when future versions
 of OCaml add some new warnings.
 
-The default setting is "-warn-error -a+31" (only warning 31 is fatal).
+The default setting is "-warn-error -a" (no warning is fatal).
 
 \item["-warn-help"]
 Show the description of all available warning numbers.

testsuite/tests/warnings/mnemonics.mll

@@ -65,11 +65,20 @@ let mnemonics =
 let mnemonic_of_constructor s =
   String.map (function '_' -> '-' | c -> Char.lowercase_ascii c) s
 
+let deprecated_warnings = function
+  | 3 | 25 | 31 -> true
+  | _  -> false
+
 let () =
   List.iter (fun (s, n) ->
       let f (c, m) = mnemonic_of_constructor c = s && n = m in
-      if not (List.exists f constructors) then
+      match List.exists f constructors, deprecated_warnings n with
+      | true, false -> ()
+      | false, true -> ()
+      | false, false ->
         Printf.printf "Could not find constructor corresponding to mnemonic %S (%d)\n%!" s n
+      | true, true ->
+        Printf.printf "Found constructor for deprecated warnings %S (%d)\n%!" s n
     ) mnemonics
 
 let _ =

typing/persistent_env.ml

@@ -164,7 +164,7 @@ let save_pers_struct penv crc ps pm =
         | Alerts _ -> ()
         | Opaque -> register_import_as_opaque penv modname)
     ps.ps_flags;
-  Consistbl.set crc_units modname crc ps.ps_filename;
+  Consistbl.check crc_units modname crc ps.ps_filename;
   add_import penv modname
 
 let acknowledge_pers_struct penv check modname pers_sig pm =

utils/consistbl.ml

@@ -56,8 +56,6 @@ end) = struct
     with Not_found ->
       raise (Not_available name)
 
-  let set tbl name crc source = Module_name.Tbl.add tbl name (crc, source)
-
   let source tbl name = snd (Module_name.Tbl.find tbl name)
 
   let extract l tbl =

utils/consistbl.mli

@@ -47,11 +47,6 @@ end) : sig
         (* Same as [check], but raise [Not_available] if no CRC was previously
              associated with [name]. *)
 
-  val set: t -> Module_name.t -> Digest.t -> filepath -> unit
-        (* [set tbl name crc source] forcefully associates [name] with
-           [crc] in [tbl], even if [name] already had a different CRC
-           associated with [name] in [tbl]. *)
-
   val source: t -> Module_name.t -> filepath
         (* [source tbl name] returns the file name associated with [name]
            if the latter has an associated CRC in [tbl].

utils/warnings.ml

@@ -65,7 +65,8 @@ type t =
   | Wildcard_arg_to_constant_constr         (* 28 *)
   | Eol_in_string                           (* 29 *)
   | Duplicate_definitions of string * string * string * string (*30 *)
-  | Module_linked_twice of string * string * string (* 31 *)
+  (* [Module_linked_twice of string * string * string] (* 31 *)
+     was turned into a hard error *)
   | Unused_value_declaration of string      (* 32 *)
   | Unused_open of string                   (* 33 *)
   | Unused_type_declaration of string       (* 34 *)
@@ -146,7 +147,6 @@ let number = function
   | Wildcard_arg_to_constant_constr -> 28
   | Eol_in_string -> 29
   | Duplicate_definitions _ -> 30
-  | Module_linked_twice _ -> 31
   | Unused_value_declaration _ -> 32
   | Unused_open _ -> 33
   | Unused_type_declaration _ -> 34
@@ -351,8 +351,10 @@ let descriptions = [
     since = None };
   { number = 31;
     names = ["module-linked-twice"];
-    description = "A module is linked twice in the same executable.";
-    since = since 4 0 };
+    description =
+      "A module is linked twice in the same executable.\n\
+      \    Ignored: now a hard error (since 5.1).";
+    since = None };
   { number = 32;
     names = ["unused-value-declaration"];
     description = "Unused value declaration.";
@@ -855,7 +857,7 @@ let parse_options errflag s =
 
 (* If you change these, don't forget to change them in man/ocamlc.m *)
 let defaults_w = "+a-4-7-9-27-29-30-32..42-44-45-48-50-60-66..70"
-let defaults_warn_error = "-a+31"
+let defaults_warn_error = "-a"
 let default_disabled_alerts = [ "unstable"; "unsynchronized_access" ]
 
 let () = ignore @@ parse_options false defaults_w
@@ -941,10 +943,6 @@ let message = function
   | Duplicate_definitions (kind, cname, tc1, tc2) ->
       Printf.sprintf "the %s %s is defined in both types %s and %s."
         kind cname tc1 tc2
-  | Module_linked_twice(modname, file1, file2) ->
-      Printf.sprintf
-        "files %s and %s both define a module named %s"
-        file1 file2 modname
   | Unused_value_declaration v -> "unused value " ^ v ^ "."
   | Unused_open s -> "unused open " ^ s ^ "."
   | Unused_open_bang s -> "unused open! " ^ s ^ "."

utils/warnings.mli

@@ -70,7 +70,6 @@ type t =
   | Wildcard_arg_to_constant_constr         (* 28 *)
   | Eol_in_string                           (* 29 *)
   | Duplicate_definitions of string * string * string * string (* 30 *)
-  | Module_linked_twice of string * string * string (* 31 *)
   | Unused_value_declaration of string      (* 32 *)
   | Unused_open of string                   (* 33 *)
   | Unused_type_declaration of string       (* 34 *)