diff --git a/ocaml/libs/vhd/vhd_format_lwt_test/parse_test.ml b/ocaml/libs/vhd/vhd_format_lwt_test/parse_test.ml
index 2f7716db27..ce77f39864 100644
--- a/ocaml/libs/vhd/vhd_format_lwt_test/parse_test.ml
+++ b/ocaml/libs/vhd/vhd_format_lwt_test/parse_test.ml
@@ -50,9 +50,17 @@ let fill_sector_with pattern =
   done ;
   b
 
+let with_new_filename f =
+  let name = make_new_filename () in
+  let safe_unlink () =
+    try Unix.unlink name with Unix.Unix_error(_,_,_) -> ()
+  in
+  safe_unlink ();
+  Fun.protect ~finally:safe_unlink (fun () -> f name)
+
 (* Create a dynamic disk, check headers *)
 let check_empty_disk size =
-  let filename = make_new_filename () in
+  with_new_filename @@ fun filename ->
   Vhd_IO.create_dynamic ~filename ~size () >>= fun vhd ->
   Vhd_IO.openchain filename false >>= fun vhd' ->
   assert_equal ~printer:Header.to_string ~cmp:Header.equal vhd.Vhd.header
@@ -64,7 +72,7 @@ let check_empty_disk size =
 (* Create a disk, resize it, check headers *)
 let check_resize size =
   let newsize = max 0L (Int64.pred size) in
-  let filename = make_new_filename () in
+  with_new_filename @@ fun filename ->
   Vhd_IO.create_dynamic ~filename ~size () >>= fun vhd ->
   let vhd = Vhd.resize vhd newsize in
   Vhd_IO.close vhd >>= fun () ->
@@ -75,9 +83,9 @@ let check_resize size =
 
 (* Create a snapshot, check headers *)
 let check_empty_snapshot size =
-  let filename = make_new_filename () in
+  with_new_filename @@ fun filename ->
   Vhd_IO.create_dynamic ~filename ~size () >>= fun vhd ->
-  let filename = make_new_filename () in
+  with_new_filename @@ fun filename ->
   Vhd_IO.create_difference ~filename ~parent:vhd () >>= fun vhd' ->
   Vhd_IO.openchain filename false >>= fun vhd'' ->
   assert_equal ~printer:Header.to_string ~cmp:Header.equal vhd'.Vhd.header
@@ -91,18 +99,18 @@ let check_empty_snapshot size =
 let check_reparent () =
   let all_ones = fill_sector_with "1" in
   let all_twos = fill_sector_with "2" in
-  let p1 = make_new_filename () in
+  with_new_filename @@ fun p1 ->
   let size = Int64.mul 1024L 1024L in
   Vhd_IO.create_dynamic ~filename:p1 ~size () >>= fun vhd ->
   (* write '1' into block 0 *)
   Vhd_IO.write vhd 0L [all_ones] >>= fun () ->
   Vhd_IO.close vhd >>= fun () ->
-  let p2 = make_new_filename () in
+  with_new_filename @@ fun p2 ->
   Vhd_IO.create_dynamic ~filename:p2 ~size () >>= fun vhd ->
   (* write '2' into block 0 *)
   Vhd_IO.write vhd 0L [all_twos] >>= fun () ->
   Vhd_IO.close vhd >>= fun () ->
-  let l = make_new_filename () in
+  with_new_filename @@ fun l ->
   Vhd_IO.openchain p1 false >>= fun vhd ->
   Vhd_IO.create_difference ~filename:l ~parent:vhd () >>= fun vhd' ->
   (* Verify block 0 has '1' *)
@@ -125,7 +133,7 @@ let check_reparent () =
 
 (* Check ../ works in parent locator *)
 let check_parent_parent_dir () =
-  let filename = make_new_filename () in
+  with_new_filename @@ fun filename ->
   Vhd_IO.create_dynamic ~filename ~size:0L () >>= fun vhd ->
   let leaf_path = Filename.(concat (concat tmp_file_dir "leaves") "leaf.vhd") in
   let leaf_dir = Filename.dirname leaf_path in
@@ -140,7 +148,7 @@ let check_parent_parent_dir () =
 
 (* Check we respect RO-ness *)
 let check_readonly () =
-  let filename = make_new_filename () in
+  with_new_filename @@ fun filename ->
   Vhd_IO.create_dynamic ~filename ~size:0L () >>= fun vhd ->
   Vhd_IO.close vhd >>= fun () ->
   Unix.chmod filename 0o444 ;