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 <[email protected]>
xcp-ng · Mar 6, 2024 · e22567d · e22567d
1 parent 21729fb
commit e22567d
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 13 deletions.
diff --git a/ocaml/quicktest/qt.ml b/ocaml/quicktest/qt.ml
@@ -132,26 +132,34 @@ 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 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
-        [
-          "vm-install"
-        ; "template-uuid=" ^ template_uuid
-        ; "new-name-label=" ^ name
-        ]
+      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
@@ -50,7 +50,7 @@ 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
@@ -91,12 +91,17 @@ 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