From da5fd2dd32ea7d6aa4e0c089941e2a5d72703a3d Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.com>
Date: Tue, 12 Feb 2019 17:43:08 +0100
Subject: Improve error message for link order error in bytelink

---
 bytecomp/bytelink.ml  | 21 +++++++++++++++++++--
 bytecomp/bytelink.mli |  1 +
 2 files changed, 20 insertions(+), 2 deletions(-)

(limited to 'bytecomp')

diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
index 350e6db78a..8af67c3b3e 100644
--- a/bytecomp/bytelink.ml
+++ b/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);
@@ -104,7 +110,8 @@ let add_required compunit =
 let remove_required (rel, _pos) =
   match rel with
     Reloc_setglobal id ->
-      missing_globals := Ident.Map.remove id !missing_globals
+      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
diff --git a/bytecomp/bytelink.mli b/bytecomp/bytelink.mli
index 82f851e6ef..2c8090c3b6 100644
--- a/bytecomp/bytelink.mli
+++ b/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
 
-- 
cgit v1.2.1