Improve error message for link order error in bytelink

Changes

@@ -251,6 +251,9 @@ Working version
   destructive substitutions
   (Thomas Refis, review by Gabriel Radanne, report by Hugo Heuzard)
 
+- #2245: Improve error message for link order error in bytecode
+  (Pierre Chambart, review by Jérémie Dimino and Gabriel Scherer)
+
 - #8732, improved error messages for invalid private row type definitions.
   For instance, [ type t = private [< `A > `A ] ] .
   (Florian Angeletti, review by Jacques Garrigue, Thomas Refis,

bytecomp/bytelink.ml

@@ -30,6 +30,7 @@ type error =
   | Cannot_open_dll of filepath
   | Required_module_unavailable of modname * modname
   | Camlheader of string * filepath
+  | Wrong_link_order of (modname * modname) list
 
 exception Error of error
 
@@ -87,6 +88,8 @@ let add_ccobjs origin l =
 (* First pass: determine which units are needed *)
 
 let missing_globals = ref Ident.Map.empty
+let provided_globals = ref Ident.Set.empty
+let badly_ordered_dependencies : (string * string) list ref = ref []
 
 let is_required (rel, _pos) =
   match rel with
@@ -96,6 +99,9 @@ let is_required (rel, _pos) =
 
 let add_required compunit =
   let add id =
+    if Ident.Set.mem id !provided_globals then
+      badly_ordered_dependencies :=
+        ((Ident.name id), compunit.cu_name) :: !badly_ordered_dependencies;
     missing_globals := Ident.Map.add id compunit.cu_name !missing_globals
   in
   List.iter add (Symtable.required_globals compunit.cu_reloc);
@@ -105,6 +111,7 @@ let remove_required (rel, _pos) =
   match rel with
     Reloc_setglobal id ->
       missing_globals := Ident.Map.remove id !missing_globals
+      provided_globals := Ident.Set.add id !provided_globals
   | _ -> ()
 
 let scan_file obj_name tolink =
@@ -627,7 +634,11 @@ let link objfiles output_name =
     match Ident.Map.bindings missing_modules with
     | [] -> ()
     | (id, cu_name) :: _ ->
-        raise (Error (Required_module_unavailable (Ident.name id, cu_name)))
+        match !badly_ordered_dependencies with
+        | [] ->
+            raise (Error (Required_module_unavailable (Ident.name id, cu_name)))
+        | l ->
+            raise (Error (Wrong_link_order l))
   end;
   Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; (* put user's libs last *)
   Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
@@ -763,6 +774,12 @@ let report_error ppf = function
       fprintf ppf "Module `%s' is unavailable (required by `%s')" s m
   | Camlheader (msg, header) ->
       fprintf ppf "System error while copying file %s: %s" header msg
+  | Wrong_link_order l ->
+      let depends_on ppf (dep, depending) =
+        fprintf ppf "%s depends on %s" depending dep
+      in
+      fprintf ppf "@[<hov 2>Wrong link order: %a@]"
+        (pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ",@ ") depends_on) l
 
 let () =
   Location.register_error_of_exn

bytecomp/bytelink.mli

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