Merge pull request #5489 from xcp-ng/fix-quicktest

xapi-project · Mar 22, 2024 · cfa6efa · cfa6efa
2 parents 9fcfbfc + 1bf250b
commit cfa6efa
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 14 deletions.
diff --git a/ocaml/quicktest/qt.ml b/ocaml/quicktest/qt.ml
@@ -132,26 +132,32 @@ 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 ~self: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
@@ -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
@@ -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