Merge pull request #5784 from Vincent-lau/private/shul2/check-param

Add new check for new parameters' default value

Author: Vincent-lau

ocaml/idl/dm_api.ml

@@ -364,33 +364,19 @@ let check api emergency_calls =
   in
   (* Sanity check 7: message parameters must be in increasing order of in_product_since *)
   let are_in_vsn_order ps =
-    let rec getlast l =
-      (* TODO: move to standard library *)
-      match l with
-      | [x] ->
-          x
-      | _ :: xs ->
-          getlast xs
-      | [] ->
-          raise (Invalid_argument "getlast")
-    in
     let release_lt x y = release_leq x y && x <> y in
     let in_since releases =
       (* been in since the lowest of releases *)
-      let rec find_smallest sofar l =
-        match l with
-        | [] ->
-            sofar
-        | "closed" :: xs ->
-            find_smallest sofar xs
-            (* closed is not a real release, so skip it *)
-        | x :: xs ->
-            if release_lt x sofar then
-              find_smallest x xs
-            else
-              find_smallest sofar xs
-      in
-      find_smallest (getlast release_order |> code_name_of_release) releases
+      List.fold_left
+        (fun sofar r ->
+          match r with
+          | "closed" ->
+              sofar (* closed is not a real release, so skip it *)
+          | r ->
+              if release_lt r sofar then r else sofar
+        )
+        (Xapi_stdext_std.Listext.List.last release_order |> code_name_of_release)
+        releases
     in
     let rec check_vsns max_release_sofar ps =
       match ps with
@@ -444,4 +430,35 @@ let check api emergency_calls =
       )
       system
   in
+  (* Sanity check 9: New parameters must have a default value: we partially check
+     this by checking in the list of parameters, after we have seen a parameter with
+     a default value, other parameters after it must have defaults as well. Unfortunately
+     checking parameters with newer releases does not work well as there are existing
+     parameters with new releases but no default. *)
+  let _ =
+    let new_param_has_default obj_name msg_name ps =
+      let _ : bool =
+        List.fold_left
+          (fun seen_default p ->
+            if seen_default && Option.is_none p.param_default then
+              Printf.sprintf
+                "Obj %s Msg %s parameters %s does not have default values"
+                obj_name msg_name p.param_name
+              |> failwith ;
+
+            Option.is_some p.param_default
+          )
+          false ps
+      in
+      ()
+    in
+
+    List.iter
+      (fun obj ->
+        List.iter
+          (fun msg -> new_param_has_default obj.name msg.msg_name msg.msg_params)
+          obj.messages
+      )
+      system
+  in
   ()

ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml

@@ -76,6 +76,14 @@ module List = struct
     in
     loop 0 list
 
+  let rec last = function
+    | [] ->
+        invalid_arg "last: empty list"
+    | [x] ->
+        x
+    | _ :: xs ->
+        last xs
+
   let sub i j l = drop i l |> take (j - max i 0)
 
   let rec chop i l =

ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.mli

@@ -27,6 +27,10 @@ module List : sig
   (** [drop n list] returns the list without the first [n] elements of [list]
       (or [] if list is shorter). *)
 
+  val last : 'a list -> 'a
+  (** [last l] returns the last element of a list or raise Invalid_argument if 
+    the list is empty *)
+
   val rev_mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
   (** [rev_map f l] gives the same result as {!Stdlib.List.rev}[ (]
       {!Stdlib.List.mapi}[ f l)], but is tail-recursive and more efficient. *)

ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext_test.ml

@@ -13,6 +13,10 @@
 
 module Listext = Xapi_stdext_std.Listext.List
 
+let test_last_list tested_f (name, case, expected) =
+  let check () = Alcotest.(check @@ int) name expected (tested_f case) in
+  (name, `Quick, check)
+
 let test_list tested_f (name, case, expected) =
   let check () = Alcotest.(check @@ list int) name expected (tested_f case) in
   (name, `Quick, check)
@@ -109,6 +113,28 @@ let test_drop =
   let tests = List.map test specs in
   ("drop", tests)
 
+let test_last =
+  let specs = [([1], 0, 1); ([1; 2; 3], 1, 3)] in
+  let error_specs = [([], -1, Invalid_argument "last: empty list")] in
+  let test_good (whole, number, expected) =
+    let name =
+      Printf.sprintf "get last %i from [%s]" number
+        (String.concat "; " (List.map string_of_int whole))
+    in
+    test_last_list Listext.last (name, whole, expected)
+  in
+  let tests = List.map test_good specs in
+  let error_test (whole, number, error) =
+    let name =
+      Printf.sprintf "last [%s] with %i fails"
+        (String.concat "; " (List.map string_of_int whole))
+        number
+    in
+    test_error (fun ls () -> ignore (Listext.last ls)) (name, whole, error)
+  in
+  let error_tests = List.map error_test error_specs in
+  ("last", tests @ error_tests)
+
 let test_chop =
   let specs =
     [
@@ -233,6 +259,7 @@ let () =
       test_iteri_right
     ; test_take
     ; test_drop
+    ; test_last
     ; test_chop
     ; test_sub
     ; test_find_minimum_int