From e69d4f53267e647c0b2184e01697921236cbb2e3 Mon Sep 17 00:00:00 2001
From: Si Beaumont <simon.beaumont@citrix.com>
Date: Thu, 3 Sep 2015 15:32:51 +0100
Subject: [PATCH] Self destruct ocamlscript executables

Changing a module that the script depends on does not cause recompilation of
the OCamlscript script. This is a known issue with OCamlscript[1] and this
patch works around this by unlinking the auto-generated binary after it has
finished executing its main Lwt thread.

[1]: https://github.com/mjambon/ocamlscript/issues/2

Signed-off-by: Si Beaumont <simon.beaumont@citrix.com>
---
 Vagrantfile          |  2 ++
 tests/test_common.ml | 16 ++++++++++++++++
 tests/test_quicktest |  6 +-----
 tests/test_thin_lvhd |  6 +-----
 4 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/Vagrantfile b/Vagrantfile
index 774b1bf..36af512 100644
--- a/Vagrantfile
+++ b/Vagrantfile
@@ -22,6 +22,8 @@ Vagrant.configure(VAGRANTFILE_API_VERSION) do |config|
         inline: "hostname host#{i}; echo host#{i} > /etc/hostname"
       host.vm.synced_folder "xs/rpms", "/rpms", type: "rsync", rsync__args: ["--verbose", "--archive", "-z", "--copy-links"]
       host.vm.synced_folder "xs/opt", "/opt", type: "rsync", rsync__args: ["--verbose", "--archive", "-z", "--copy-links"]
+      host.vm.synced_folder "xs/sbin", "/sbin", type: "rsync", rsync__args: ["--verbose", "--archive", "-z", "--copy-links"]
+      host.vm.synced_folder "xs/bin", "/bin", type: "rsync", rsync__args: ["--verbose", "--archive", "-z", "--copy-links"]
       host.vm.synced_folder "scripts/xs", "/scripts", type: "rsync", rsync__args: ["--verbose", "--archive", "-z", "--copy-links"]
 
       host.vm.provision "shell", path: "scripts/xs/update.sh"
diff --git a/tests/test_common.ml b/tests/test_common.ml
index e43a35d..85943c4 100644
--- a/tests/test_common.ml
+++ b/tests/test_common.ml
@@ -203,3 +203,19 @@ let get_control_domain state host =
     (fun (vm_ref, vm_rec) ->
        vm_rec.API.vM_resident_on=host && vm_rec.API.vM_is_control_domain)
     vms |> fst |> Lwt.return
+
+let run_and_self_destruct (t : 'a Lwt.t) : 'a =
+  let t' =
+    Lwt.finalize (fun () -> t) (fun () ->
+      let name = Sys.argv.(0) in
+      let ocamlscript_exe =
+        if Filename.check_suffix name "exe" then name else name ^ ".exe" in
+      if (try Unix.(access ocamlscript_exe [ F_OK ]); true with _ -> false)
+      then
+        Lwt_io.printlf "Unlinking ocamlscript compilation: %s" ocamlscript_exe
+        >>= fun () ->
+        Lwt_unix.unlink ocamlscript_exe
+      else return ()
+    )
+  in
+  Lwt_main.run t'
diff --git a/tests/test_quicktest b/tests/test_quicktest
index 98583c1..cb3194c 100755
--- a/tests/test_quicktest
+++ b/tests/test_quicktest
@@ -28,12 +28,8 @@ let _ =
     Printf.printf "Quicktest has run!\n%!";
     Lwt.return ()
   in
-  Lwt_main.run th;
+  run_and_self_destruct th;
 
 (* Local Variables: *)
 (* mode: tuareg *)
 (* End: *)
-  
-
-
-
diff --git a/tests/test_thin_lvhd b/tests/test_thin_lvhd
index cc2c592..5a89b75 100755
--- a/tests/test_thin_lvhd
+++ b/tests/test_thin_lvhd
@@ -83,12 +83,8 @@ let _ =
     >>= fun () ->
     Lwt.return ()
   in
-  Lwt_main.run th;
+  run_and_self_destruct th;
 
 (* Local Variables: *)
 (* mode: tuareg *)
 (* End: *)
-  
-
-
-