[OCaml version] replication works

src/client.ml

@@ -945,8 +945,8 @@ let remote action =
           Globals.error_and_exit "%s is not a remote index" n in
       update_config (List.filter ((!=) repo) repos)
 
-let switch oversion =
-  log "switch %s" (OCaml_V.to_string oversion);
+let switch to_replicate oversion =
+  log "switch %B %s" to_replicate (OCaml_V.to_string oversion);
   let t = load_state () in
 
   let f_init = 
@@ -966,7 +966,7 @@ let switch oversion =
            else
              Globals.error_and_exit "Unknown file format (%s)" comp_src) in
       let () = Repositories.Raw.rsync [`A ; `R] comp_src ocaml_tgz in
-      let build_dir = Path.C.build_ocaml t.compiler in
+      let build_dir = Path.C.build_ocaml new_oversion in
       let () = Filename.extract ocaml_tgz build_dir in
 
       match
@@ -987,10 +987,36 @@ let switch oversion =
               end)
         | error -> Globals.error_and_exit "compilation of OCaml failed (%d)" error in
 
-  File.Config.write (Path.G.config t.global) (File.Config.with_ocaml_version t.config oversion);
-  match f_init with
-    | None -> ()
-    | Some f -> f ()
+  begin
+    (* [1/2] initialization: write the new version in the configuration file *)
+    File.Config.write (Path.G.config t.global) (File.Config.with_ocaml_version t.config oversion);
+
+    (* [2/2] initialization: initialize everything as if "opam init" has been called *)
+    (match f_init with
+      | None -> ()
+      | Some f -> f ());
+
+    (if to_replicate then
+        (* attempt to replicate the previous state *)
+        let t_new = load_state () in
+        resolve t_new
+          { wish_install = 
+              List.map 
+                (fun (n, v) -> vpkg_of_nv (NV.create n (V.Set.choose_one v)))
+                (N.Map.bindings 
+                   (NV.Set.fold
+                      (fun nv map ->
+                        let name, version = NV.name nv, NV.version nv in
+                        if name = N.of_string Globals.default_package then
+                          (* [Globals.default_package] has already been installed for this new version (automatically), we skip it *)
+                          map
+                        else
+                          N.Map.add name (try N.Map.find name map with Not_found -> V.Set.singleton version) map)
+                      t.installed
+                      (NV.to_map t_new.installed)))
+          ; wish_remove = [] 
+          ; wish_upgrade = [] });
+  end
 
 
 (** We protect each main functions with a lock. *)

src/client.mli

@@ -52,5 +52,7 @@ val remove : N.t -> unit
 (** Manage remote repositories. Take the global file lock. *)
 val remote : remote -> unit
 
-(** Switch to an OCaml compiler. Take the global file lock. *)
-val switch: OCaml_V.t -> unit
+(** [switch and_clone] switch to an OCaml compiler 
+    and clone at the end in case [and_clone] is [true].
+    Take the global file lock. *)
+val switch: bool -> OCaml_V.t -> unit

src/opam.ml

@@ -55,8 +55,9 @@ let parse_args fn () =
   fn (List.rev !ano_args)
 
 (* opam init [-kind $kind] $repo $adress *)
-let kind = ref Globals.default_repository_kind
-let init = {
+let init = 
+  let kind = ref Globals.default_repository_kind in
+{
   name     = "init";
   usage    = "";
   synopsis = "Initial setup";
@@ -190,11 +191,12 @@ let upgrade = {
 }
 
 (* opam upload PACKAGE *)
-let opam = ref ""
-let descr = ref ""
-let archive = ref ""
-let repo = ref ""
-let upload = {
+let upload = 
+  let opam = ref "" in
+  let descr = ref "" in
+  let archive = ref "" in
+  let repo = ref "" in
+{
   name     = "upload";
   usage    = "";
   synopsis = "Upload a package to the server";
@@ -232,10 +234,11 @@ let remove = {
 }
 
 (* opam remote [-list|-add <url>|-rm <url>] *)
-let kind = ref Globals.default_repository_kind
-let command : [`add|`list|`rm] option ref = ref None
-let set c () = command := Some c
-let remote = {
+let remote = 
+  let kind = ref Globals.default_repository_kind in
+  let command : [`add|`list|`rm] option ref = ref None in
+  let set c () = command := Some c in
+{
   name     = "remote";
   usage    = "[-list|add <name> <address>|rm <name>]";
   synopsis = "Manage remote servers";
@@ -257,16 +260,23 @@ let remote = {
     | _        -> bad_argument "remote" "Wrong arguments")
 }
 
-let switch = {
+(* opam switch [-clone] OVERSION *)
+let switch = 
+  let command : [`clone] option ref = ref None in
+  let set c () = command := Some c in
+{
   name     = "switch";
   usage    = "[compiler-name]";
   synopsis = "Switch to an other compiler version";
   help     = "";
-  specs    = [];
+  specs    = [
+    ("-clone" , Arg.Unit (set `clone), " List the repositories");
+  ];
   anon;
-  main     = parse_args (function
-    |[]      -> bad_argument "switch" "Compiler name is missing"
-    | [name] -> Client.switch (OCaml_V.of_string name)
+  main     = parse_args (fun args ->
+    match args with
+    | []     -> bad_argument "switch" "Compiler name is missing"
+    | [name] -> Client.switch (!command <> None) (OCaml_V.of_string name)
     | _      -> bad_argument "switch" "Too many compiler names")
 }
 

src/solver.ml

@@ -183,18 +183,7 @@ module CudfDiff : sig
 
 end = struct
 
-  module Cudf_set = struct
-    module S = Common.CudfAdd.Cudf_set
-
-    let choose_one s = match S.cardinal s with
-      | 0 -> raise Not_found
-      | 1 -> S.choose s
-      | _ -> failwith "TODO"
-    (* Apparently the returned sets are always singleton.
-       XXX: check that it is always the case *)
-
-    include S
-  end
+  module Cudf_set = Set.MK (Common.CudfAdd.Cudf_set)
 
   let to_cudf_doc univ req = 
     None, 

src/types.ml

@@ -15,6 +15,28 @@
 
 let log fmt = Globals.log "TYPES" fmt
 
+module Set = struct
+  module type S = sig
+    include Set.S
+
+    (** Like [choose] and [Assert_failure _] in case the set is not a singleton. *)
+    val choose_one : t -> elt
+  end
+
+  module MK (S : Set.S) = struct
+    include S
+
+    let choose_one s = 
+      match elements s with
+        | [x] -> x
+        | _ -> assert false
+  end
+
+  module Make (O : Set.OrderedType) = struct
+    include MK (Set.Make (O))
+  end
+end
+
 module type Abstract = sig
   type t
   val of_string: string -> t

src/types.mli

@@ -15,6 +15,22 @@
 
 (** The OPAM types and then main function which operates on them. *)
 
+(** {2 Pervasives} *)
+
+module Set : sig
+  module type S = sig
+    include Set.S
+
+    (** Like [choose] and [Assert_failure _] in case the set is not a singleton. *)
+    val choose_one : t -> elt
+  end
+
+  module MK : functor (S : Set.S) -> S 
+    with type t = S.t with type elt = S.elt
+  module Make : functor (Ord : Set.OrderedType) -> S 
+    with type elt = Ord.t
+end
+
 (** {2 Abstract types} *)
 
 (** All abstract types should implement this signature *)