From d929dc9a5d910066454dec9de4d0521a1ca13713 Mon Sep 17 00:00:00 2001
From: BenjiReis <benjamin.reis@vates.fr>
Date: Tue, 18 Jul 2023 13:24:18 +0200
Subject: [PATCH] Allow a user to select on which SR to run quicktest

- New `-sr` option which takes a SR uuid to run the tests on
the option is mutually exclusive with `-default-sr`

- If the SR provided is not available on the host, fails

Signed-off-by: BenjiReis <benjamin.reis@vates.fr>
---
 ocaml/quicktest/qt_filter.ml      | 15 ++++++++++++++-
 ocaml/quicktest/quicktest_args.ml | 12 +++++++++++-
 2 files changed, 25 insertions(+), 2 deletions(-)

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 <hostname> <username> and \
      <password> 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"