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