Permalink
Browse files

[fix] package,objectFile: better message for cyclic package deps

  • Loading branch information...
1 parent 458f101 commit ba1304e053901ce673fb312ae42dd7217e24f6fb @OpaOnWindowsNow OpaOnWindowsNow committed Jul 19, 2012
Showing with 22 additions and 13 deletions.
  1. +14 −6 compiler/compilerlib/objectFiles.ml
  2. +6 −5 ocamllib/libbase/topologicSort.ml
  3. +2 −2 ocamllib/libbase/topologicSort.mli
@@ -1,4 +1,4 @@
-(*
+ (*
Copyright © 2011, 2012 MLstate
This file is part of Opa.
@@ -1436,11 +1436,19 @@ let reorder :
let get_cache all_packages =
try S.compute all_packages
- with S.CyclicDep t ->
- match t with
- | None -> assert false (* you shouldn't be able to have cycles with the linking part *)
- | Some (name,pos) ->
- OManager.error "%a@\n Cyclic dependency on the package %s." FilePos.pp_pos pos name in
+ with S.CyclicDep l ->
+ let names = List.filter_map (fun v -> v) l in
+ assert (names <> []); (* you shouldn't be able to have cycles with the linking part *)
+ let (guilty,pos) as g = Base.List.last names in
+ let cycle_path = fst (List.split (
+ match Base.List.memi g names with
+ | None -> names
+ | Some i -> List.drop i names
+ ))
+ in
+ OManager.error "%a@\nCyclic dependency on the package %s.\nThe cycle is: [ %a ].\n" FilePos.pp_pos pos guilty
+ (BaseFormat.pp_list "@? -> " BaseFormat.pp_print_string) cycle_path
+ in
let cache = get_cache all_packages in
let transitive_closure_one =
let rmap = ref !TopologicMPackage.rmap in
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of Opa.
@@ -30,7 +30,7 @@ end
module type S =
sig
type t
- exception CyclicDep of t
+ exception CyclicDep of t list
exception IndexConflict of t * t
exception Not_found_index of string
val sort : t list -> t list * (string * t list) list
@@ -44,7 +44,7 @@ end
module Make (Elemt: ItemType) : S with type t = Elemt.t =
struct
type t = Elemt.t
- exception CyclicDep of t
+ exception CyclicDep of t list
exception IndexConflict of t * t
exception Not_found_index of string
type infos_elt =
@@ -77,9 +77,9 @@ struct
let rec visite s infos_elt =
if Hashtbl.mem visited s
then ()
- else
+ else try
if Hashtbl.mem detect_cycle s
- then raise (CyclicDep infos_elt.tri_topo_elt)
+ then raise (CyclicDep [])
else
let tri_topo_elt = infos_elt.tri_topo_elt in
begin
@@ -101,6 +101,7 @@ struct
Hashtbl.add visited s ();
Stack.push tri_topo_elt ordered
end
+ with CyclicDep l -> raise (CyclicDep (infos_elt.tri_topo_elt::l))
in
(* Faire le parcours dans l'ordre donne : stabilite du tri topo *)
List.iter (fun (a, b) -> visite a b) list_dep;
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of Opa.
@@ -57,7 +57,7 @@ sig
(**
raised if one of the [t] is in a cyclic dependency loop.
*)
- exception CyclicDep of t
+ exception CyclicDep of t list
(**
raised if 2 [t] of the input list of [sort] have

0 comments on commit ba1304e

Please sign in to comment.