diff --git a/ocaml/quicktest/qt_filter.ml b/ocaml/quicktest/qt_filter.ml index 7f132624d8e..7d5a11e9aad 100644 --- a/ocaml/quicktest/qt_filter.ml +++ b/ocaml/quicktest/qt_filter.ml @@ -180,7 +180,20 @@ module SR = struct ~self:pool ) () - else + else if !A.sr <> "" then ( + let sr = + Client.Client.SR.get_by_uuid ~rpc:!A.rpc ~session_id:!session_id + ~uuid:!A.sr + in + let local_srs = + list_srs_connected_to_localhost !A.rpc !session_id + |> List.map (fun sr_info -> sr_info.Qt.sr) + in + if not (List.mem sr local_srs) then + failwith + (Printf.sprintf "Specified sr %s is not available on the host" !A.sr) ; + only sr () + ) else Lazy.force all_srs let random srs () = diff --git a/ocaml/quicktest/quicktest_args.ml b/ocaml/quicktest/quicktest_args.ml index 0741de4d1d7..da394f1fd27 100644 --- a/ocaml/quicktest/quicktest_args.ml +++ b/ocaml/quicktest/quicktest_args.ml @@ -12,6 +12,8 @@ let password = ref "" let host = ref "" +let sr = ref "" + let using_unix_domain_socket = ref true let http = Xmlrpc_client.xmlrpc ~version:"1.1" "/" @@ -45,9 +47,15 @@ let parse () = ) ; ( "-default-sr" , Arg.Unit (fun () -> use_default_sr := true) - , "Only run SR tests on the pool's default SR" + , "Only run SR tests on the pool's default SR, mutually exclusive with \ + -sr" ) ; ("-nocolour", Arg.Clear use_colour, "Don't use colour in the output") + ; ( "-sr" + , Arg.String (fun x -> sr := x) + , "Only run SR tests on the specified SR, mutually exclusive with \ + -default-sr" + ) ] (fun x -> match (!host, !username, !password) with @@ -65,6 +73,8 @@ let parse () = "Perform some quick functional tests. The default is to test localhost \ over a Unix socket. For remote server supply and \ arguments." ; + if !use_default_sr && !sr <> "" then + raise (Arg.Bad "-default-sr and -sr are mutually exclusive") ; if !host = "" then host := "localhost" ; if !username = "" then username := "root"