From 5015566e762420fb4bfcdce1ba22f1bbbaff4212 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= <francois.bobot@cea.fr>
Date: Wed, 4 Mar 2015 09:49:11 +0100
Subject: [PATCH 2/2] [Dynlink] forbid package loading when we are currently   
        initializing a package

---
 src/findlib/fl_dynlink.ml  | 28 ++++++++++++++++++++++++----
 src/findlib/fl_dynlink.mli | 13 ++++++++++++-
 2 files changed, 36 insertions(+), 5 deletions(-)

diff --git a/src/findlib/fl_dynlink.ml b/src/findlib/fl_dynlink.ml
index b64b617..78c688c 100644
--- a/src/findlib/fl_dynlink.ml
+++ b/src/findlib/fl_dynlink.ml
@@ -1,6 +1,15 @@
 
 (** Utilities for loading dynamically packages *)
 
+exception Package_loading
+
+let package_loading = ref false
+let is_package_loading () =
+  (** At least "findlib.dynlink" should be in the list if Findlib_initl has
+      been run. Otherwise we are running statically linked package  *)
+  !Findlib.linked_packages = []
+  || !package_loading
+
 let load_pkg pkg =
   if not (List.mem pkg !Findlib.linked_packages) then
     (* Determine the package directory: *)
@@ -8,7 +17,8 @@ let load_pkg pkg =
     (* Determine the 'archive(plugin,...)' property: *)
     let archive =
       try
-        Findlib.package_property ("plugin"::!Findlib.linked_predicates) pkg "archive"
+        Findlib.package_property
+          ("plugin"::!Findlib.linked_predicates) pkg "archive"
       with Not_found -> "" in
     (* Split the 'archive' property and resolve the files: *)
     let files = Fl_split.in_words archive in
@@ -19,7 +29,17 @@ let load_pkg pkg =
     Findlib.linked_packages := pkg::!Findlib.linked_packages
 
 let load_packages pkgs =
-  let eff_pkglist =
-    Findlib.package_deep_ancestors !Findlib.linked_predicates pkgs in
-  List.iter load_pkg eff_pkglist
+  if is_package_loading () then
+    raise Package_loading
+  else begin
+    package_loading := true;
+    try
+      let eff_pkglist =
+        Findlib.package_deep_ancestors !Findlib.linked_predicates pkgs in
+      List.iter load_pkg eff_pkglist ;
+      package_loading := false;
+    with exn ->
+      package_loading := false;
+      raise exn
+  end
 
diff --git a/src/findlib/fl_dynlink.mli b/src/findlib/fl_dynlink.mli
index 1109442..a615486 100644
--- a/src/findlib/fl_dynlink.mli
+++ b/src/findlib/fl_dynlink.mli
@@ -5,5 +5,16 @@
 
 (** Utilities for loading dynamically packages *)
 
+exception Package_loading
+(** Indicate that during the loading of a package the loading of another
+    package have been requested *)
+
 val load_packages : string list -> unit
-(** Dynlink the given packages and all their dependencies *)
+(** Dynlink the given packages and all their dependencies;
+    Call can't be nested.
+    @raise Package_loading
+*)
+
+
+val is_package_loading: unit -> bool
+(** Indicate if we are currently loading a package *)
-- 
2.1.4