From 5bbf1be4d10e68a819051b1894c3458329b0565d Mon Sep 17 00:00:00 2001
From: Yann Dirson <yann.dirson@vates.fr>
Date: Tue, 5 Mar 2024 16:55:30 +0100
Subject: [PATCH] Quicktest_vm_lifecycle: use requested SR not default SR

This test did not exercised the SR type expected by user, and notably
failed when no default SR was defined.

Adds the option of installing a VM in a non-default SR using
VM.with_new.

Signed-off-by: Yann Dirson <yann.dirson@vates.fr>
---
 ocaml/quicktest/qt.ml                     | 24 +++++++++++++----------
 ocaml/quicktest/qt.mli                    |  7 ++++++-
 ocaml/quicktest/quicktest_vm_lifecycle.ml | 12 +++++++++---
 3 files changed, 29 insertions(+), 14 deletions(-)

diff --git a/ocaml/quicktest/qt.ml b/ocaml/quicktest/qt.ml
index 1764f12ce8..6e78dfff2e 100644
--- a/ocaml/quicktest/qt.ml
+++ b/ocaml/quicktest/qt.ml
@@ -132,26 +132,30 @@ module VM = struct
           Some x
   end
 
-  let install rpc session_id ~template ~name =
+  let install rpc session_id ~template ~name ?sr () =
     let template_uuid =
       Client.Client.VM.get_uuid ~rpc ~session_id ~self:template
     in
-    let newvm_uuid =
-      cli_cmd
-        [
-          "vm-install"
-        ; "template-uuid=" ^ template_uuid
-        ; "new-name-label=" ^ name
-        ]
+    let cmd =
+      ["vm-install"; "template-uuid=" ^ template_uuid; "new-name-label=" ^ name]
     in
+    let sr_uuid =
+      Option.map (fun sr -> Client.Client.SR.get_uuid rpc session_id sr) sr
+    in
+    let cmd =
+      cmd @ Option.fold ~none:[] ~some:(fun x -> ["sr-uuid=" ^ x]) sr_uuid
+    in
+    let newvm_uuid = cli_cmd cmd in
     Client.Client.VM.get_by_uuid ~rpc ~session_id ~uuid:newvm_uuid
 
   let uninstall rpc session_id vm =
     let uuid = Client.Client.VM.get_uuid ~rpc ~session_id ~self:vm in
     cli_cmd ["vm-uninstall"; "uuid=" ^ uuid; "--force"] |> ignore
 
-  let with_new rpc session_id ~template f =
-    let vm = install rpc session_id ~template ~name:"temp_quicktest_vm" in
+  let with_new rpc session_id ~template ?sr f =
+    let vm =
+      install rpc session_id ~template ~name:"temp_quicktest_vm" ?sr ()
+    in
     Xapi_stdext_pervasives.Pervasiveext.finally
       (fun () -> f vm)
       (fun () -> uninstall rpc session_id vm)
diff --git a/ocaml/quicktest/qt.mli b/ocaml/quicktest/qt.mli
index f0edde13a5..15dbb785f2 100644
--- a/ocaml/quicktest/qt.mli
+++ b/ocaml/quicktest/qt.mli
@@ -50,7 +50,12 @@ module VM : sig
   end
 
   val with_new :
-    rpc -> API.ref_session -> template:API.ref_VM -> (API.ref_VM -> 'a) -> 'a
+       rpc
+    -> API.ref_session
+    -> template:API.ref_VM
+    -> ?sr:API.ref_SR
+    -> (API.ref_VM -> 'a)
+    -> 'a
 
   val dom0_of_host : rpc -> API.ref_session -> API.ref_host -> API.ref_VM
   (** Return a host's domain zero *)
diff --git a/ocaml/quicktest/quicktest_vm_lifecycle.ml b/ocaml/quicktest/quicktest_vm_lifecycle.ml
index 88fd9b8d66..b3de6b5b30 100644
--- a/ocaml/quicktest/quicktest_vm_lifecycle.ml
+++ b/ocaml/quicktest/quicktest_vm_lifecycle.ml
@@ -91,12 +91,18 @@ let one rpc session_id vm test =
   | Halted ->
       wait_for_domid (fun domid' -> domid' = -1L)
 
-let test rpc session_id vm_template () =
-  Qt.VM.with_new rpc session_id ~template:vm_template (fun vm ->
+let test rpc session_id sr_info vm_template () =
+  let sr = sr_info.Qt.sr in
+  Qt.VM.with_new rpc session_id ~template:vm_template ~sr (fun vm ->
       List.iter (one rpc session_id vm) all_possible_tests
   )
 
 let tests () =
   let open Qt_filter in
-  [[("VM lifecycle tests", `Slow, test)] |> conn |> vm_template "CoreOS"]
+  [
+    [("VM lifecycle tests", `Slow, test)]
+    |> conn
+    |> sr SR.(all |> allowed_operations [`vdi_create])
+    |> vm_template "CoreOS"
+  ]
   |> List.concat