From 845ffdd4cd1ca14d66c9dd8eefd2ee5bd38d9553 Mon Sep 17 00:00:00 2001 From: Andrii Sultanov Date: Fri, 28 Jun 2024 16:09:21 +0100 Subject: [PATCH] Eliminate unnecessary usage of List.length to check for empty lists Signed-off-by: Andrii Sultanov --- ocaml/idl/dtd_backend.ml | 4 +- ocaml/libs/ezxenstore/core/watch.ml | 2 +- ocaml/libs/http-lib/buf_io.ml | 2 +- ocaml/libs/xml-light2/xml.ml | 2 +- .../powershell/gen_powershell_binding.ml | 12 +- ocaml/tests/common/alcotest_comparators.ml | 4 +- ocaml/xapi-cli-server/cli_frontend.ml | 2 +- ocaml/xapi-cli-server/cli_operations.ml | 123 +++++++++--------- ocaml/xapi-cli-server/cli_printer.ml | 3 +- ocaml/xapi-idl/lib_test/updates_test.ml | 8 +- ocaml/xapi/create_misc.ml | 4 +- ocaml/xapi/create_storage.ml | 2 +- ocaml/xapi/helpers.ml | 2 +- ocaml/xapi/map_check.ml | 2 +- ocaml/xapi/message_forwarding.ml | 2 +- ocaml/xapi/workload_balancing.ml | 2 +- ocaml/xapi/xapi_bond.ml | 2 +- ocaml/xapi/xapi_ha.ml | 6 +- ocaml/xapi/xapi_host.ml | 4 +- ocaml/xapi/xapi_network.ml | 2 +- ocaml/xapi/xapi_pbd.ml | 2 +- ocaml/xapi/xapi_pgpu_helpers.ml | 2 +- ocaml/xapi/xapi_pif.ml | 2 +- ocaml/xapi/xapi_pool.ml | 16 +-- ocaml/xapi/xapi_pool_update.ml | 2 +- ocaml/xapi/xapi_pvs_proxy.ml | 2 +- ocaml/xapi/xapi_role.ml | 4 +- ocaml/xapi/xapi_session.ml | 6 +- ocaml/xapi/xapi_sr.ml | 2 +- ocaml/xapi/xapi_sr_operations.ml | 6 +- ocaml/xapi/xapi_vdi.ml | 2 +- ocaml/xapi/xapi_vm_appliance_lifecycle.ml | 4 +- ocaml/xapi/xapi_vm_helpers.ml | 2 +- ocaml/xapi/xapi_vmss.ml | 7 +- ocaml/xapi/xapi_xenops.ml | 4 +- ocaml/xe-cli/newcli.ml | 2 +- .../async_examples/event_test.ml | 2 +- ocaml/xenopsd/test/test.ml | 2 +- ocaml/xenopsd/xc/domain.ml | 2 +- ocaml/xenopsd/xc/hotplug.ml | 9 +- quality-gate.sh | 23 +++- 41 files changed, 159 insertions(+), 134 deletions(-) diff --git a/ocaml/idl/dtd_backend.ml b/ocaml/idl/dtd_backend.ml index e94cf4a9178..da448043c39 100644 --- a/ocaml/idl/dtd_backend.ml +++ b/ocaml/idl/dtd_backend.ml @@ -41,7 +41,7 @@ let is_element = function Element (_, _, _) -> true | _ -> false let string_of_attribute = function | Attribute (n, options, default) -> let opt_string = - if List.length options = 0 then + if options = [] then "CDATA" else "(" ^ String.concat " | " options ^ ")" @@ -59,7 +59,7 @@ let string_of_attribute = function sprintf "%s %s %s" n opt_string def_string let strings_of_attributes parent atts = - if List.length atts > 0 then + if atts <> [] then let prefix = sprintf ""] diff --git a/ocaml/libs/ezxenstore/core/watch.ml b/ocaml/libs/ezxenstore/core/watch.ml index 93cd19af3d1..35f3aee0b5e 100644 --- a/ocaml/libs/ezxenstore/core/watch.ml +++ b/ocaml/libs/ezxenstore/core/watch.ml @@ -51,7 +51,7 @@ let wait_for ~xs ?(timeout = 300.) (x : 'a t) = Thread.create (fun () -> let r, _, _ = Unix.select [p1] [] [] timeout in - if List.length r > 0 then + if r <> [] then () else try Xs_client_unix.Task.cancel task with _ -> () diff --git a/ocaml/libs/http-lib/buf_io.ml b/ocaml/libs/http-lib/buf_io.ml index efeda873c5f..6a6397a614c 100644 --- a/ocaml/libs/http-lib/buf_io.ml +++ b/ocaml/libs/http-lib/buf_io.ml @@ -80,7 +80,7 @@ let fill_buf ~buffered ic timeout = let buf_size = Bytes.length ic.buf in let fill_no_exc timeout len = let l, _, _ = Unix.select [ic.fd] [] [] timeout in - if List.length l <> 0 then ( + if l <> [] then ( let n = Unix.read ic.fd ic.buf ic.max len in ic.max <- n + ic.max ; if n = 0 && len <> 0 then raise Eof ; diff --git a/ocaml/libs/xml-light2/xml.ml b/ocaml/libs/xml-light2/xml.ml index 78811ae55d2..9b58f2f6cf0 100644 --- a/ocaml/libs/xml-light2/xml.ml +++ b/ocaml/libs/xml-light2/xml.ml @@ -121,7 +121,7 @@ let esc_pcdata data = let str_of_attrs attrs = let fmt s = Printf.sprintf s in - if List.length attrs > 0 then + if attrs <> [] then " " ^ String.concat " " (List.map (fun (k, v) -> fmt "%s=\"%s\"" k (esc_pcdata v)) attrs) diff --git a/ocaml/sdk-gen/powershell/gen_powershell_binding.ml b/ocaml/sdk-gen/powershell/gen_powershell_binding.ml index b455d010486..0e8c6566dc7 100644 --- a/ocaml/sdk-gen/powershell/gen_powershell_binding.ml +++ b/ocaml/sdk-gen/powershell/gen_powershell_binding.ml @@ -644,14 +644,14 @@ and gen_destructor obj classname messages = Licence.bsd_two_clause (ocaml_class_to_csharp_class classname) (qualified_class_name classname) - ( if List.length asyncMessages > 0 then + ( if asyncMessages <> [] then "\n [OutputType(typeof(XenAPI.Task))]" else "" ) (ocaml_class_to_csharp_class classname) (print_xenobject_params obj classname true true true) - ( if List.length asyncMessages > 0 then + ( if asyncMessages <> [] then sprintf "\n\ \ protected override bool GenerateAsyncParam\n\ @@ -725,7 +725,7 @@ and gen_remover obj classname messages = Licence.bsd_two_clause (ocaml_class_to_csharp_class classname) (qualified_class_name classname) - ( if List.length asyncMessages > 0 then + ( if asyncMessages <> [] then "\n [OutputType(typeof(XenAPI.Task))]" else "" @@ -790,7 +790,7 @@ and gen_setter obj classname messages = Licence.bsd_two_clause (ocaml_class_to_csharp_class classname) (qualified_class_name classname) - ( if List.length asyncMessages > 0 then + ( if asyncMessages <> [] then "\n [OutputType(typeof(XenAPI.Task))]" else "" @@ -855,7 +855,7 @@ and gen_adder obj classname messages = Licence.bsd_two_clause (ocaml_class_to_csharp_class classname) (qualified_class_name classname) - ( if List.length asyncMessages > 0 then + ( if asyncMessages <> [] then "\n [OutputType(typeof(XenAPI.Task))]" else "" @@ -1060,7 +1060,7 @@ and is_message_with_dynamic_params classname message = let nonClassParams = List.filter (fun x -> not (is_class x classname)) message.msg_params in - if List.length nonClassParams > 0 || message.msg_async then + if nonClassParams <> [] || message.msg_async then true else false diff --git a/ocaml/tests/common/alcotest_comparators.ml b/ocaml/tests/common/alcotest_comparators.ml index 21f596875ea..5b4704c3177 100644 --- a/ocaml/tests/common/alcotest_comparators.ml +++ b/ocaml/tests/common/alcotest_comparators.ml @@ -59,6 +59,6 @@ let vdi_operations_set : API.vdi_operations_set Alcotest.testable = ) (fun o1 o2 -> List.length (intersect o1 o2) = List.length o1 - && List.length (set_difference o1 o2) = 0 - && List.length (set_difference o2 o1) = 0 + && set_difference o1 o2 = [] + && set_difference o2 o1 = [] ) diff --git a/ocaml/xapi-cli-server/cli_frontend.ml b/ocaml/xapi-cli-server/cli_frontend.ml index 13c695da5db..a3e2eaf5b5a 100644 --- a/ocaml/xapi-cli-server/cli_frontend.ml +++ b/ocaml/xapi-cli-server/cli_frontend.ml @@ -3918,7 +3918,7 @@ let rio_help printer minimal cmd = ) cmd.params in - if List.length cmds > 0 then + if cmds <> [] then List.iter docmd (List.map fst cmds) else let cmds = diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index 54eace11b69..cdd29e778be 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -229,7 +229,7 @@ let get_hosts_by_name_or_id rpc session_id name = let get_host_by_name_or_id rpc session_id name = let hosts = get_hosts_by_name_or_id rpc session_id name in - if List.length hosts = 0 then failwith ("Host " ^ name ^ " not found") ; + if hosts = [] then failwith ("Host " ^ name ^ " not found") ; List.nth hosts 0 let get_host_from_session rpc session_id = @@ -862,7 +862,7 @@ let make_param_funs getallrecs getbyuuid record class_name def_filters ] in let ops = - if List.length settable > 0 then + if settable <> [] then ( cli_name "param-set" , ["uuid"] , settable @@ -877,7 +877,7 @@ let make_param_funs getallrecs getbyuuid record class_name def_filters ops in let ops = - if List.length addable > 0 then + if addable <> [] then ops @ [ ( cli_name "param-add" @@ -902,7 +902,7 @@ let make_param_funs getallrecs getbyuuid record class_name def_filters ops in let ops = - if List.length clearable > 0 then + if clearable <> [] then ops @ [ ( cli_name "param-clear" @@ -2928,13 +2928,7 @@ let event_wait_gen rpc session_id classname record_matches = (List.map (fun r -> (r.name, fun () -> safe_get_field r))) current_tbls in - debug "Got %d records" (List.length all_recs) ; - (* true if anything matches now *) - let find_any_match recs = - let ls = List.map record_matches recs in - List.length (List.filter (fun x -> x) ls) > 0 - in - find_any_match all_recs + List.exists record_matches all_recs in finally (fun () -> @@ -3305,9 +3299,9 @@ let do_host_op rpc session_id op params ?(multiple = true) ignore_params = failwith "No matching hosts found" | 1 -> [op 1 (List.hd hosts)] - | _ -> + | len -> if multiple && get_bool_param params "multiple" then - do_multiple (op (List.length hosts)) hosts + do_multiple (op len) hosts else failwith ( if not multiple then @@ -3917,11 +3911,13 @@ let vm_install_real printer rpc session_id template name description params = failwith "SR specified via sr-uuid doesn't have the name specified via \ sr-name-label" - | None -> - if List.length sr_list > 1 then + | None -> ( + match sr_list with + | [x] -> + Some x + | _ -> failwith "Multiple SRs with that name-label found" - else - Some (List.hd sr_list) + ) ) else sr_ref @@ -4058,12 +4054,12 @@ let vm_install printer rpc session_id params = List.fold_left filter_records_on_fields all_recs (("name-label", name) :: filter_params) in - match List.length templates with - | 0 -> + match templates with + | [] -> failwith "No templates matched" - | 1 -> - (List.hd templates).getref () - | _ -> + | [x] -> + x.getref () + | _ :: _ :: _ -> failwith "More than one matching template found" in if @@ -4114,7 +4110,7 @@ let console fd _printer rpc session_id params = | [] -> marshal fd (Command (PrintStderr "No VM found\n")) ; raise (ExitWithError 1) - | _ :: _ -> + | _ :: _ :: _ -> marshal fd (Command (PrintStderr @@ -4153,9 +4149,10 @@ let vm_uninstall_common fd _printer rpc session_id params vms = (* add extra text if the VDI is being shared *) let r = Client.VDI.get_record ~rpc ~session_id ~self:vdi in Printf.sprintf "VDI: %s (%s) %s" r.API.vDI_uuid r.API.vDI_name_label - ( if List.length r.API.vDI_VBDs <= 1 then + ( match r.API.vDI_VBDs with + | [] | [_] -> "" - else + | _ :: _ :: _ -> " ** WARNING: disk is shared by other VMs" ) in @@ -4477,18 +4474,15 @@ let vm_retrieve_wlb_recommendations printer rpc session_id params = in try let vms = select_vms rpc session_id params [] in - match List.length vms with - | 0 -> + match vms with + | [] -> failwith "No matching VMs found" - | 1 -> + | [x] -> printer (Cli_printer.PTable - [ - ("Host(Uuid)", "Stars, RecID, ZeroScoreReason") - :: table (List.hd vms) - ] + [("Host(Uuid)", "Stars, RecID, ZeroScoreReason") :: table x] ) - | _ -> + | _ :: _ :: _ -> failwith "Multiple VMs found. Operation can only be performed on one VM at a \ time" @@ -4628,7 +4622,7 @@ let vm_migrate printer rpc session_id params = ) pifs in - if List.length management_pifs = 0 then + if management_pifs = [] then failwith (Printf.sprintf "Could not find management PIF on host %s" host_record.API.host_uuid @@ -5026,7 +5020,7 @@ let vm_disk_remove printer rpc session_id params = (fun x -> device = Client.VBD.get_userdevice ~rpc ~session_id ~self:x) vm_record.API.vM_VBDs in - if List.length vbd_to_remove < 1 then + if vbd_to_remove = [] then failwith "Disk not found" else let vbd = List.nth vbd_to_remove 0 in @@ -5052,7 +5046,7 @@ let vm_cd_remove printer rpc session_id params = ) vm_record.API.vM_VBDs in - if List.length vbd_to_remove < 1 then + if vbd_to_remove = [] then raise (failwith "Disk not found") else let vbd = List.nth vbd_to_remove 0 in @@ -5071,7 +5065,7 @@ let vm_cd_add printer rpc session_id params = ) vdis in - if List.length vdis = 0 then failwith ("CD " ^ cd_name ^ " not found!") ; + if vdis = [] then failwith ("CD " ^ cd_name ^ " not found!") ; let vdi = List.nth vdis 0 in let op vm = create_vbd_and_plug rpc session_id (vm.getref ()) vdi @@ -5094,9 +5088,14 @@ let vm_cd_eject printer rpc session_id params = (fun vbd -> Client.VBD.get_type ~rpc ~session_id ~self:vbd = `CD) vbds in - if List.length cdvbds = 0 then failwith "No CDs found" ; - if List.length cdvbds > 1 then - failwith "Two or more CDs found. Please use vbd-eject" ; + ( match cdvbds with + | [] -> + failwith "No CDs found" + | [_] -> + () + | _ :: _ :: _ -> + failwith "Two or more CDs found. Please use vbd-eject" + ) ; let cd = List.hd cdvbds in Client.VBD.eject ~rpc ~session_id ~vbd:cd in @@ -5113,13 +5112,18 @@ let vm_cd_insert printer rpc session_id params = ) vdis in - if List.length vdis = 0 then failwith ("CD " ^ cd_name ^ " not found") ; - if List.length vdis > 1 then - failwith - ("Multiple CDs named " - ^ cd_name - ^ " found. Please use vbd-insert and specify uuids" - ) ; + ( match vdis with + | [] -> + failwith ("CD " ^ cd_name ^ " not found") + | [_] -> + () + | _ :: _ :: _ -> + failwith + ("Multiple CDs named " + ^ cd_name + ^ " found. Please use vbd-insert and specify uuids" + ) + ) ; let op vm = let vm_record = vm.record () in let vbds = vm_record.API.vM_VBDs in @@ -5131,15 +5135,16 @@ let vm_cd_insert printer rpc session_id params = ) vbds in - if List.length cdvbds = 0 then - raise - (Api_errors.Server_error - (Api_errors.vm_no_empty_cd_vbd, [Ref.string_of (vm.getref ())]) - ) ; - if List.length cdvbds > 1 then - failwith "Two or more empty CD devices found. Please use vbd-insert" ; - let cd = List.hd cdvbds in - Client.VBD.insert ~rpc ~session_id ~vbd:cd ~vdi:(List.hd vdis) + match cdvbds with + | [] -> + raise + (Api_errors.Server_error + (Api_errors.vm_no_empty_cd_vbd, [Ref.string_of (vm.getref ())]) + ) + | [cd] -> + Client.VBD.insert ~rpc ~session_id ~vbd:cd ~vdi:(List.hd vdis) + | _ :: _ :: _ -> + failwith "Two or more empty CD devices found. Please use vbd-insert" in ignore (do_vm_op printer rpc session_id op params ["cd-name"]) @@ -5555,7 +5560,7 @@ let pool_retrieve_wlb_report fd _printer rpc session_id params = in download_file_with_task fd rpc session_id filename Constants.wlb_report_uri (Printf.sprintf "report=%s%s%s" (Http.urlencode report) - (if List.length other_params = 0 then "" else "&") + (if other_params = [] then "" else "&") (String.concat "&" (List.map (fun (k, v) -> @@ -5978,7 +5983,7 @@ let vm_is_bios_customized printer rpc session_id params = let bios_strings = Client.VM.get_bios_strings ~rpc ~session_id ~self:(vm.getref ()) in - if List.length bios_strings = 0 then + if bios_strings = [] then printer (Cli_printer.PMsg "The BIOS strings of this VM have not yet been set.") else if bios_strings = Constants.generic_bios_strings then @@ -7259,7 +7264,7 @@ let subject_role_common rpc session_id params = let roles = Client.Role.get_by_name_label ~rpc ~session_id ~label:role_name in - if List.length roles > 0 then + if roles <> [] then List.hd roles (* names are unique, there's either 0 or 1*) else Ref.null diff --git a/ocaml/xapi-cli-server/cli_printer.ml b/ocaml/xapi-cli-server/cli_printer.ml index 5aace44caa1..1fc1d5586fd 100644 --- a/ocaml/xapi-cli-server/cli_printer.ml +++ b/ocaml/xapi-cli-server/cli_printer.ml @@ -56,7 +56,8 @@ let make_printer sock minimal = let multi_line_xapi_minimal pval = match pval with | PTable rs -> - if List.length rs > 0 && List.length (List.hd rs) > 0 then + (* Check that all the sublists aren't empty before calling List.hd *) + if rs <> [] && List.for_all (fun r -> r <> []) rs then let names = List.map (fun r -> snd (List.hd r)) rs in let escaped_names = List.map escape_commas names in buffer := String.concat "," escaped_names :: !buffer diff --git a/ocaml/xapi-idl/lib_test/updates_test.ml b/ocaml/xapi-idl/lib_test/updates_test.ml index c9604b35b52..66c5f09450e 100644 --- a/ocaml/xapi-idl/lib_test/updates_test.ml +++ b/ocaml/xapi-idl/lib_test/updates_test.ml @@ -35,7 +35,7 @@ let test_add () = let test_noadd () = let u = M.empty scheduler in let _barriers, updates, _id = M.get "dbg" None (Some 0) u in - assert_bool "Update returned" (List.length updates = 0) + assert_bool "Update returned" (updates = []) (* Tests that we can remove an update, and that it's not then returned by 'get' *) let test_remove () = @@ -43,7 +43,7 @@ let test_remove () = M.add update_a u ; M.remove update_a u ; let _barriers, updates, _id = M.get "dbg" None (Some 0) u in - assert_bool "Update returned" (List.length updates = 0) + assert_bool "Update returned" (updates = []) (* Tests that, if we specify a timeout, the 'get' call returns the empty list after that timeout. *) @@ -53,7 +53,7 @@ let test_timeout () = let _, l, _ = M.get "dbg" None (Some 1) u in let duration = Unix.gettimeofday () -. before in assert_bool "Duration greater than 1 sec" (duration > 1.0 && duration < 2.0) ; - assert_bool "Returned list was empty" (List.length l = 0) + assert_bool "Returned list was empty" (l = []) (* Checks that if we add an event after a blocking 'get' call that the call is unblocked. Verifies that the call returns immediately and that the correct @@ -112,7 +112,7 @@ let test_remove_barrier () = M.add update_c u ; M.remove_barrier 1 u ; let barriers, updates, _id = M.get "dbg" None (Some 1) u in - assert_bool "Barrier returned" (List.length barriers = 0) ; + assert_bool "Barrier returned" (barriers = []) ; assert_bool "Updates contain all updates" (List.nth updates 0 = update_b && List.nth updates 1 = update_a diff --git a/ocaml/xapi/create_misc.ml b/ocaml/xapi/create_misc.ml index a41f8a072e0..1b6e26ab84d 100644 --- a/ocaml/xapi/create_misc.ml +++ b/ocaml/xapi/create_misc.ml @@ -71,7 +71,7 @@ let make_xen_livepatch_list () = ) [] lines in - if List.length patches > 0 then Some (String.concat ", " patches) else None + if patches <> [] then Some (String.concat ", " patches) else None (** The format of the response looks like * # kpatch list @@ -104,7 +104,7 @@ let make_kpatch_list () = loop acc started rest in let patches = loop [] false lines in - if List.length patches > 0 then Some (String.concat ", " patches) else None + if patches <> [] then Some (String.concat ", " patches) else None (** [count_cpus] returns the number of CPUs found in /proc/cpuinfo *) let count_cpus () = diff --git a/ocaml/xapi/create_storage.ml b/ocaml/xapi/create_storage.ml index cc982db4800..19aff8ecbbd 100644 --- a/ocaml/xapi/create_storage.ml +++ b/ocaml/xapi/create_storage.ml @@ -90,7 +90,7 @@ let maybe_create_pbd rpc session_id sr device_config me = ) else pbds in - if List.length pbds = 0 (* If there's no PBD, create it *) then + if pbds = [] (* If there's no PBD, create it *) then Client.PBD.create ~rpc ~session_id ~host:me ~sR:sr ~device_config ~other_config:[] else diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index ba58ddd7b92..2af8173d202 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -1192,7 +1192,7 @@ let gethostbyname_family host family = Unix.getaddrinfo host "" [Unix.AI_SOCKTYPE Unix.SOCK_STREAM; Unix.AI_FAMILY family] in - if List.length he = 0 then + if he = [] then throw_resolve_error () ; Unix.string_of_inet_addr (getaddr (List.hd he).Unix.ai_addr) diff --git a/ocaml/xapi/map_check.ml b/ocaml/xapi/map_check.ml index d907f31090a..0cb2d97e37f 100644 --- a/ocaml/xapi/map_check.ml +++ b/ocaml/xapi/map_check.ml @@ -132,7 +132,7 @@ let with_ks ~kss ~fn = let corrected_values = List.filter (fun cv -> cv <> None) (List.map (fun ks -> fn field ks) kss) in - if List.length corrected_values < 1 then + if corrected_values = [] then [] else match List.hd corrected_values with None -> [] | Some cv -> cv diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 6be9f50d4c0..0beeee3f8ab 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -4527,7 +4527,7 @@ functor info "Bond.create: network = '%s'; members = [ %s ]" (network_uuid ~__context network) (String.concat "; " (List.map (pif_uuid ~__context) members)) ; - if List.length members = 0 then + if members = [] then raise (Api_errors.Server_error (Api_errors.pif_bond_needs_more_members, []) ) ; diff --git a/ocaml/xapi/workload_balancing.ml b/ocaml/xapi/workload_balancing.ml index 2d8300c45f1..be73658daf2 100644 --- a/ocaml/xapi/workload_balancing.ml +++ b/ocaml/xapi/workload_balancing.ml @@ -142,7 +142,7 @@ let is_childless elem = | Xml.Element (_, _, [Xml.PCData _]) -> true | Xml.Element (_, _, children) -> - List.length children = 0 + children = [] | Xml.PCData _ -> true diff --git a/ocaml/xapi/xapi_bond.ml b/ocaml/xapi/xapi_bond.ml index 20764394b36..173a789ac2b 100644 --- a/ocaml/xapi/xapi_bond.ml +++ b/ocaml/xapi/xapi_bond.ml @@ -98,7 +98,7 @@ let get_local_vifs ~__context host networks = false else let hosts = Xapi_vm.get_possible_hosts ~__context ~vm in - (List.mem host hosts && List.length hosts = 1) || List.length hosts = 0 + (List.mem host hosts && List.length hosts = 1) || hosts = [] in (* Make a list of the VIFs for local VMs *) let vms = Hashtbl.to_seq_keys vms_with_vifs |> List.of_seq in diff --git a/ocaml/xapi/xapi_ha.ml b/ocaml/xapi/xapi_ha.ml index 2295651ed05..9937fea6f28 100644 --- a/ocaml/xapi/xapi_ha.ml +++ b/ocaml/xapi/xapi_ha.ml @@ -1777,7 +1777,7 @@ let enable __context heartbeat_srs configuration = ) ) in - if List.length unplugged_ununpluggable_pifs > 0 then + if unplugged_ununpluggable_pifs <> [] then raise (Api_errors.Server_error ( Api_errors.required_pif_is_unplugged @@ -1804,7 +1804,7 @@ let enable __context heartbeat_srs configuration = ) not_bond_slaves in - if List.length without_disallow_unplug > 0 then ( + if without_disallow_unplug <> [] then ( let pifinfo = List.map (fun (pif, pifr) -> @@ -1874,7 +1874,7 @@ let enable __context heartbeat_srs configuration = else heartbeat_srs in - if List.length possible_srs = 0 then + if possible_srs = [] then raise (Api_errors.Server_error (Api_errors.cannot_create_state_file, [])) ; (* For the moment we'll create a state file in one compatible SR since the xHA component only handles one *) let srs = [List.hd possible_srs] in diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml index 01b76be3d85..897e4674332 100644 --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -199,7 +199,7 @@ let assert_bacon_mode ~__context ~host = |> List.flatten |> List.filter (fun self -> Db.VBD.get_currently_attached ~__context ~self) in - if List.length control_domain_vbds > 0 then + if control_domain_vbds <> [] then raise (Api_errors.Server_error ( Api_errors.host_in_use @@ -1093,7 +1093,7 @@ let destroy ~__context ~self = if Db.Pool.get_ha_enabled ~__context ~self:pool then raise (Api_errors.Server_error (Api_errors.ha_is_enabled, [])) ; let my_control_domains, my_regular_vms = get_resident_vms ~__context ~self in - if List.length my_regular_vms > 0 then + if my_regular_vms <> [] then raise (Api_errors.Server_error (Api_errors.host_has_resident_vms, [Ref.string_of self]) diff --git a/ocaml/xapi/xapi_network.ml b/ocaml/xapi/xapi_network.ml index bb641e980c2..3aefbad3be8 100644 --- a/ocaml/xapi/xapi_network.ml +++ b/ocaml/xapi/xapi_network.ml @@ -108,7 +108,7 @@ let attach_internal ?(management_interface = false) ?(force_bringup = false) ) else ( (* Ensure internal bridge exists and is up. external bridges will be brought up through Nm.bring_pif_up. *) - if List.length local_pifs = 0 then + if local_pifs = [] then create_internal_bridge ~__context ~bridge:net.API.network_bridge ~uuid:net.API.network_uuid ~persist ; (* Check if we're a Host-Internal Management Network (HIMN) (a.k.a. guest-installer network) *) diff --git a/ocaml/xapi/xapi_pbd.ml b/ocaml/xapi/xapi_pbd.ml index 4b6b5c22711..67fc069c8df 100644 --- a/ocaml/xapi/xapi_pbd.ml +++ b/ocaml/xapi/xapi_pbd.ml @@ -234,7 +234,7 @@ let unplug ~__context ~self = (fun vdi -> Db.VDI.get_type ~__context ~self:vdi <> `metadata) vdis in - if List.length non_metadata_vdis > 0 then + if non_metadata_vdis <> [] then raise (Api_errors.Server_error (Api_errors.vdi_in_use, List.map Ref.string_of non_metadata_vdis) diff --git a/ocaml/xapi/xapi_pgpu_helpers.ml b/ocaml/xapi/xapi_pgpu_helpers.ml index dc49ec33a83..77f5ee7282f 100644 --- a/ocaml/xapi/xapi_pgpu_helpers.ml +++ b/ocaml/xapi/xapi_pgpu_helpers.ml @@ -133,7 +133,7 @@ let get_remaining_capacity_internal ~__context ~self ~vgpu_type List.exists (fun (_, pgpu) -> pgpu = self) pre_allocate_list in let pci = Db.PGPU.get_PCI ~__context ~self in - let scheduled = List.length (get_scheduled_VGPUs ~__context ~self) > 0 in + let scheduled = get_scheduled_VGPUs ~__context ~self <> [] in let attached = Db.PCI.get_attached_VMs ~__context ~self:pci <> [] in convert_capacity (if scheduled || attached || pre_allocated then 0L else 1L) diff --git a/ocaml/xapi/xapi_pif.ml b/ocaml/xapi/xapi_pif.ml index f7bbd19ae19..d6d7a16a692 100644 --- a/ocaml/xapi/xapi_pif.ml +++ b/ocaml/xapi/xapi_pif.ml @@ -704,7 +704,7 @@ let create_VLAN ~__context ~device ~network ~host ~vLAN = ) other_pifs in - if List.length base_pifs = 0 then + if base_pifs = [] then raise (Api_errors.Server_error (Api_errors.invalid_value, ["device"; device])) ; let tagged_PIF = List.hd base_pifs in diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index 2d3a13304c7..da7991167db 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -356,7 +356,7 @@ let pre_join_checks ~__context ~rpc ~session_id ~force = ) my_vms in - if List.length my_running_vms > 0 then ( + if my_running_vms <> [] then ( error "The current host has running or suspended VMs: it cannot join a new \ pool" ; @@ -369,11 +369,9 @@ let pre_join_checks ~__context ~rpc ~session_id ~force = let assert_no_vms_with_current_ops () = let my_vms = Db.VM.get_all_records ~__context in let vms_with_current_ops = - List.filter - (fun (_, vmr) -> List.length vmr.API.vM_current_operations > 0) - my_vms + List.filter (fun (_, vmr) -> vmr.API.vM_current_operations <> []) my_vms in - if List.length vms_with_current_ops > 0 then ( + if vms_with_current_ops <> [] then ( error "The current host has VMs with current operations: it cannot join a \ new pool" ; @@ -2680,7 +2678,7 @@ let enable_external_auth ~__context ~pool:_ ~config ~service_name ~auth_type = !_rollback_list in (* 3. if any failed, then do a best-effort rollback, disabling any host that has been just enabled *) - if List.length rollback_list > 0 then (* FAILED *) + if rollback_list <> [] then (* FAILED *) let failed_host = (* the failed host is the first item in the rollback list *) List.hd rollback_list @@ -2803,7 +2801,7 @@ let disable_external_auth ~__context ~pool:_ ~config = let failedhosts_list = List.filter (fun (_, err, _) -> err <> "") host_msgs_list in - if List.length failedhosts_list > 0 then ((* FAILED *) + if failedhosts_list <> [] then ((* FAILED *) match List.hd failedhosts_list with | host, err, msg -> debug @@ -3073,7 +3071,7 @@ let enable_local_storage_caching ~__context ~self:_ = failed ) in - if List.length failed_hosts > 0 then + if failed_hosts <> [] then raise (Api_errors.Server_error ( Api_errors.hosts_failed_to_enable_caching @@ -3097,7 +3095,7 @@ let disable_local_storage_caching ~__context ~self:_ = hosts ) in - if List.length failed_hosts > 0 then + if failed_hosts <> [] then raise (Api_errors.Server_error ( Api_errors.hosts_failed_to_disable_caching diff --git a/ocaml/xapi/xapi_pool_update.ml b/ocaml/xapi/xapi_pool_update.ml index 1a9b8544bad..a7ec305a9a6 100644 --- a/ocaml/xapi/xapi_pool_update.ml +++ b/ocaml/xapi/xapi_pool_update.ml @@ -608,7 +608,7 @@ let pool_apply ~__context ~self = ) unapplied_hosts [] in - if List.length failed_hosts > 0 then + if failed_hosts <> [] then raise (Api_errors.Server_error (Api_errors.update_pool_apply_failed, failed_hosts) diff --git a/ocaml/xapi/xapi_pvs_proxy.ml b/ocaml/xapi/xapi_pvs_proxy.ml index 136daeef4be..3f81ffc783e 100644 --- a/ocaml/xapi/xapi_pvs_proxy.ml +++ b/ocaml/xapi/xapi_pvs_proxy.ml @@ -25,7 +25,7 @@ let create ~__context ~site ~vIF = Xapi_database.Db_filter_types.(Eq (Field "VIF", Literal (Ref.string_of vIF))) in let proxies = Db.PVS_proxy.get_refs_where ~__context ~expr in - if List.length proxies > 0 then + if proxies <> [] then raise Api_errors.( Server_error (pvs_proxy_already_present, List.map Ref.string_of proxies) diff --git a/ocaml/xapi/xapi_role.ml b/ocaml/xapi/xapi_role.ml index f63f13caa74..6e562023ceb 100644 --- a/ocaml/xapi/xapi_role.ml +++ b/ocaml/xapi/xapi_role.ml @@ -193,7 +193,7 @@ let get_is_internal ~__context ~self = let get_permissions_common ~__context ~role ~ret_value_fn = let rec rec_get_permissions_of_role ~__context ~role = let subroles = get_subroles ~__context ~self:role in - if List.length subroles = 0 then + if subroles = [] then (* base case = leaf node = permission is role itself *) [ret_value_fn role] else (* step = go recursively down composite roles *) @@ -233,7 +233,7 @@ let get_by_permission ~__context ~permission = let get_by_permission_name_label ~__context ~label = let permission = let ps = get_by_name_label ~__context ~label in - if List.length ps > 0 then + if ps <> [] then List.hd ps (* names are unique, there's either 0 or 1*) else Ref.null diff --git a/ocaml/xapi/xapi_session.ml b/ocaml/xapi/xapi_session.ml index c0341cecf37..1417b4d8313 100644 --- a/ocaml/xapi/xapi_session.ml +++ b/ocaml/xapi/xapi_session.ml @@ -522,7 +522,7 @@ let revalidate_external_session ~__context ~session = in debug "verified intersection for session %s, sid %s " (trackid session) authenticated_user_sid ; - let in_intersection = List.length intersection > 0 in + let in_intersection = intersection <> [] in if not in_intersection then ( (* empty intersection: externally-authenticated subject no longer has login rights in the pool *) let msg = @@ -1012,7 +1012,7 @@ let login_with_password ~__context ~uname ~pwd ~version:_ ~originator = intersect reflexive_membership_closure subject_ids_in_db in (* 2.3. finally, we create the session for the authenticated subject if any membership intersection was found *) - let in_intersection = List.length intersection > 0 in + let in_intersection = intersection <> [] in if not in_intersection then ( (* empty intersection: externally-authenticated subject has no login rights in the pool *) let msg = @@ -1053,7 +1053,7 @@ let login_with_password ~__context ~uname ~pwd ~version:_ ~originator = get_permissions ~__context ~subject_membership in (* CP-1260: If a subject has no roles assigned, then authentication will fail with an error such as PERMISSION_DENIED.*) - if List.length rbac_permissions < 1 then ( + if rbac_permissions = [] then ( let msg = Printf.sprintf "Subject %s (identifier %s) has no roles in this \ diff --git a/ocaml/xapi/xapi_sr.ml b/ocaml/xapi/xapi_sr.ml index 18cba6800aa..7b5186d5195 100644 --- a/ocaml/xapi/xapi_sr.ml +++ b/ocaml/xapi/xapi_sr.ml @@ -151,7 +151,7 @@ let scan_all ~__context = ) srs in - if List.length scannable_srs > 0 then + if scannable_srs <> [] then debug "Automatically scanning SRs = [ %s ]" (String.concat ";" (List.map Ref.string_of scannable_srs)) ; List.iter (scan_one ~__context) scannable_srs diff --git a/ocaml/xapi/xapi_sr_operations.ml b/ocaml/xapi/xapi_sr_operations.ml index 5d4cc834750..55c0d6805c6 100644 --- a/ocaml/xapi/xapi_sr_operations.ml +++ b/ocaml/xapi/xapi_sr_operations.ml @@ -146,10 +146,10 @@ let valid_operations ~__context ?op record _ref' : table = ) ) in - if List.length all_pbds_attached_to_this_sr > 0 then - set_errors Api_errors.sr_has_pbd [_ref] [`destroy; `forget] - else + if all_pbds_attached_to_this_sr = [] then () + else + set_errors Api_errors.sr_has_pbd [_ref] [`destroy; `forget] in let check_no_pbds ~__context _record = (* If the SR has no PBDs, destroy is not allowed. *) diff --git a/ocaml/xapi/xapi_vdi.ml b/ocaml/xapi/xapi_vdi.ml index 6a2fa244c84..f2f1ed12688 100644 --- a/ocaml/xapi/xapi_vdi.ml +++ b/ocaml/xapi/xapi_vdi.ml @@ -123,7 +123,7 @@ let check_operation_error ~__context ?sr_records:_ ?(pbd_records = []) ) pbd_records in - if List.length pbds_attached = 0 && List.mem op [`resize] then + if pbds_attached = [] && List.mem op [`resize] then Some (Api_errors.sr_no_pbds, [Ref.string_of sr]) else (* check to see whether VBDs exist which are using this VDI *) diff --git a/ocaml/xapi/xapi_vm_appliance_lifecycle.ml b/ocaml/xapi/xapi_vm_appliance_lifecycle.ml index ea752291a49..330d028cf1c 100644 --- a/ocaml/xapi/xapi_vm_appliance_lifecycle.ml +++ b/ocaml/xapi/xapi_vm_appliance_lifecycle.ml @@ -18,11 +18,11 @@ let check_operation_error ~__context record self op = let _ref = Ref.string_of self in let current_ops = record.Db_actions.vM_appliance_current_operations in (* Only allow one operation of [`start | `clean_shutdown | `hard_shutdown | `shutdown ] at a time. *) - if List.length current_ops > 0 then + if current_ops <> [] then Some (Api_errors.other_operation_in_progress, ["VM_appliance"; _ref]) else let vms = Db.VM_appliance.get_VMs ~__context ~self in - if List.length vms = 0 then + if vms = [] then Some (Api_errors.operation_not_allowed, ["Appliance has no VMs."]) else (* Allow the op if any VMs are in a state where the op makes sense. *) let power_states = diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index d8b9855686e..fc393be0252 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -1484,7 +1484,7 @@ let assert_valid_bios_strings ~__context ~value = let copy_bios_strings ~__context ~vm ~host = (* only allow to fill in BIOS strings if they are not yet set *) let current_strings = Db.VM.get_bios_strings ~__context ~self:vm in - if List.length current_strings > 0 then + if current_strings <> [] then raise (Api_errors.Server_error (Api_errors.vm_bios_strings_already_set, [])) else let bios_strings = Db.Host.get_bios_strings ~__context ~self:host in diff --git a/ocaml/xapi/xapi_vmss.ml b/ocaml/xapi/xapi_vmss.ml index 46599f129ad..03badb83b60 100644 --- a/ocaml/xapi/xapi_vmss.ml +++ b/ocaml/xapi/xapi_vmss.ml @@ -240,12 +240,11 @@ let destroy_all_messages ~__context ~self = let destroy ~__context ~self = assert_licensed ~__context ; let vms = Db.VMSS.get_VMs ~__context ~self in - if List.length vms > 0 then (* we can't delete a VMSS that contains VMs *) - raise (Api_errors.Server_error (Api_errors.vmss_has_vm, [])) - else ( + if vms = [] then ( destroy_all_messages ~__context ~self ; Db.VMSS.destroy ~__context ~self - ) + ) else (* we can't delete a VMSS that contains VMs *) + raise (Api_errors.Server_error (Api_errors.vmss_has_vm, [])) (* Verify if snapshot is happening due to a VM Schedule Snapshot *) let is_vmss_snapshot ~__context = diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 33bcbb7a958..4a45462095f 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -3049,7 +3049,7 @@ let resync_resident_on ~__context = in (* Log the state before we do anything *) let maybe_log_em msg prefix l = - if List.length l > 0 then ( + if l <> [] then ( debug "%s" msg ; List.iter (fun ((id, _), queue) -> debug "%s %s (%s)" prefix id queue) l ) @@ -3067,7 +3067,7 @@ let resync_resident_on ~__context = nowhere." "In xenopsd but resident nowhere: " xapi_thinks_are_nowhere ; (* This is pretty bad! *) - if List.length xapi_vms_not_in_xenopsd > 0 then ( + if xapi_vms_not_in_xenopsd <> [] then ( debug "The following VMs are not known to xenopsd, but xapi thought they \ should have been" ; diff --git a/ocaml/xe-cli/newcli.ml b/ocaml/xe-cli/newcli.ml index 6768c413c73..e038b402c6d 100644 --- a/ocaml/xe-cli/newcli.ml +++ b/ocaml/xe-cli/newcli.ml @@ -811,7 +811,7 @@ let main () = let args, traceparent = parse_args args in (* All the named args are taken as permitted filename to be uploaded *) let permitted_filenames = get_permit_filenames args in - if List.length args < 1 then + if args = [] then raise Usage else with_open_channels @@ fun (ic, oc) -> diff --git a/ocaml/xen-api-client/async_examples/event_test.ml b/ocaml/xen-api-client/async_examples/event_test.ml index 18b6c5a319d..7107a8bda8f 100644 --- a/ocaml/xen-api-client/async_examples/event_test.ml +++ b/ocaml/xen-api-client/async_examples/event_test.ml @@ -74,7 +74,7 @@ let watch_events rpc session_id = Event.from ~rpc ~session_id ~classes:["*"] ~token:"" ~timeout:0. >>= fun rpc -> let e = event_from_of_rpc rpc in - if List.length e.events = 0 then error "Empty list of events" ; + if List.is_empty e.events then error "Empty list of events" ; let current = List.fold_left ~init:StringMap.empty ~f:update e.events in Sequence.iter ~f:(fun (key, diff) -> diff --git a/ocaml/xenopsd/test/test.ml b/ocaml/xenopsd/test/test.ml index cc373222c41..befadd5e739 100644 --- a/ocaml/xenopsd/test/test.ml +++ b/ocaml/xenopsd/test/test.ml @@ -85,7 +85,7 @@ let wait_for_tasks id = (List.length deltas) ; flush stderr ) ; - if List.length deltas = 0 then + if deltas = [] then failwith (Printf.sprintf "no deltas, next_id = %d" next_id) ; event_id := Some next_id ; List.iter diff --git a/ocaml/xenopsd/xc/domain.ml b/ocaml/xenopsd/xc/domain.ml index f78e7179e6a..540e1a13652 100644 --- a/ocaml/xenopsd/xc/domain.ml +++ b/ocaml/xenopsd/xc/domain.ml @@ -797,7 +797,7 @@ let destroy (task : Xenops_task.task_handle) ~xc ~xs ~qemu_domid ~vtpm ~dm domid cleanup. If there are any remaining domains with the same UUID, then zap only the hotplug tree for the destroyed domain. *) if failed_devices = [] then - if List.length other_domains < 1 then + if other_domains = [] then log_exn_rm ~xs (Device_common.get_private_path_by_uuid uuid) else log_exn_rm ~xs (Hotplug.get_hotplug_base_by_uuid uuid domid) ; diff --git a/ocaml/xenopsd/xc/hotplug.ml b/ocaml/xenopsd/xc/hotplug.ml index 06a4edec85d..1eac8c8a7e0 100644 --- a/ocaml/xenopsd/xc/hotplug.ml +++ b/ocaml/xenopsd/xc/hotplug.ml @@ -286,10 +286,11 @@ let release (task : Xenops_task.task_handle) ~xc ~xs (x : device) = and the private path is indexed by UUID, not domid. *) let vm_uuid = Xenops_helpers.uuid_of_domid ~xs x.frontend.domid in let domains_of_vm = Xenops_helpers.domains_of_uuid ~xc vm_uuid in - if List.length domains_of_vm <= 1 then - Some (get_private_data_path_of_device x) - else - None + match domains_of_vm with + | [] | [_] -> + Some (get_private_data_path_of_device x) + | _ :: _ :: _ -> + None in let extra_xenserver_path = extra_xenserver_path_of_device ~xs x in Xs.transaction xs (fun t -> diff --git a/quality-gate.sh b/quality-gate.sh index b504ed69d1b..33f54e26e54 100755 --- a/quality-gate.sh +++ b/quality-gate.sh @@ -3,7 +3,7 @@ set -e list-hd () { - N=312 + N=308 LIST_HD=$(git grep -r --count 'List.hd' -- **/*.ml | cut -d ':' -f 2 | paste -sd+ - | bc) if [ "$LIST_HD" -eq "$N" ]; then echo "OK counted $LIST_HD List.hd usages" @@ -93,6 +93,26 @@ ocamlyacc () { fi } +unnecessary-length () { + N=0 + local_grep () { + git grep -r -o --count "$1" -- '**/*.ml' | wc -l + } + UNNECESSARY_LENGTH=$(local_grep "List.length.*=+\s*0") + UNNECESSARY_LENGTH=$((UNNECESSARY_LENGTH+$(local_grep "0\s*=+\s*List.length"))) + UNNECESSARY_LENGTH=$((UNNECESSARY_LENGTH+$(local_grep "List.length.*\s>\s*0"))) + UNNECESSARY_LENGTH=$((UNNECESSARY_LENGTH+$(local_grep "0\s*<\s*List.length"))) + UNNECESSARY_LENGTH=$((UNNECESSARY_LENGTH+$(local_grep "List.length.*\s<\s*1"))) + UNNECESSARY_LENGTH=$((UNNECESSARY_LENGTH+$(local_grep "1\s*>\s*List.length"))) + if [ "$UNNECESSARY_LENGTH" -eq "$N" ]; then + echo "OK found $UNNECESSARY_LENGTH unnecessary usages of List.length in OCaml files." + else + echo "ERROR expected $N unnecessary usages of List.length in OCaml files, + got $UNNECESSARY_LENGTH. Use lst =/<> [] or match statements instead." 1>&2 + exit 1 + fi +} + list-hd verify-cert mli-files @@ -100,4 +120,5 @@ structural-equality vtpm-unimplemented vtpm-fields ocamlyacc +unnecessary-length