QCheck.0.90 migration

.github/workflows/common.yml

@@ -87,7 +87,7 @@ jobs:
         uses: actions/checkout@v6
         with:
           repository: c-cube/qcheck
-          ref: v0.26
+          ref: v0.90
           path: multicoretests/qcheck
 
       - name: Pre-Setup

CHANGES.md

@@ -2,7 +2,8 @@
 
 ## NEXT RELEASE
 
-- ...
+- #578: Port libraries and test suite to qcheck-core.0.90,
+        incl. adjusting the `Lin.int_small` distribution to include negative numbers.
 
 ## 0.11
 

doc/example/stm_tests.ml

@@ -21,7 +21,7 @@ struct
     let char =
       if s=[]
       then Gen.printable
-      else Gen.(oneof [oneofl (List.map fst s); printable]) in
+      else Gen.(oneof [oneof_list (List.map fst s); printable]) in
     let int = Gen.nat in
     QCheck.make ~print:show_cmd
       (Gen.oneof

doc/paper-examples/stm_tests.ml

@@ -23,7 +23,7 @@ struct
     let char =
       if s=[]
       then Gen.printable
-      else Gen.(oneof [oneofl (List.map fst s); printable]) in
+      else Gen.(oneof [oneof_list (List.map fst s); printable]) in
     let int = Gen.nat in
     QCheck.make ~print:show_cmd
       (Gen.oneof

doc/stm/mutable_set_v5.ml

@@ -113,7 +113,7 @@ module Lib_spec : Spec = struct
     let gen =
       match state with
       | [] -> Gen.int
-      | xs -> Gen.(oneof [oneofl xs; int])
+      | xs -> Gen.(oneof [oneof_list xs; int])
     in
     QCheck.make ~print:show_cmd
       (QCheck.Gen.oneof

dune-project

@@ -18,7 +18,7 @@ the multicore run-time of OCaml 5.0.")
  (tags ("test" "test suite" "property" "qcheck" "quickcheck" "multicore" "non-determinism"))
  (depends
   base-domains
-  (qcheck-core          (>= "0.25"))
+  (qcheck-core          (>= "0.90"))
   (qcheck-lin           (= :version))
   (qcheck-stm           (= :version))))
 
@@ -32,7 +32,7 @@ sequential and parallel tests against a declarative model.")
  (depopts base-domains)
  (depends
   (ocaml (>= 4.12))
-  (qcheck-core           (>= "0.25"))
+  (qcheck-core           (>= "0.90"))
   (qcheck-multicoretests-util (= :version))))
 
 (package
@@ -47,7 +47,7 @@ and explained by some sequential interleaving.")
  (depopts base-domains)
  (depends
   (ocaml (>= 4.12))
-  (qcheck-core           (>= "0.25"))
+  (qcheck-core           (>= "0.90"))
   (qcheck-multicoretests-util (= :version))))
 
 (package
@@ -58,4 +58,4 @@ multicore programs.")
  (tags ("test" "property" "qcheck" "quickcheck" "multicore" "non-determinism"))
  (depends
   (ocaml (>= 4.12))
-  (qcheck-core           (>= "0.25"))))
+  (qcheck-core           (>= "0.90"))))

lib/lin.ml

@@ -157,16 +157,17 @@ let gen gen print = Gen (gen,print)
 let deconstructible print eq = Deconstr (print,eq)
 let gen_deconstructible gen print eq = GenDeconstr (gen,print,eq)
 
-let qcheck_nat64_small = QCheck.(map Int64.of_int small_nat)
+let qcheck_nat64_small = QCheck.(map Int64.of_int nat_small)
 
 (* QCheck's string shrinker reduces each char repeatedly which is too excessive for Lin *)
 let shrink_char c = QCheck.(if c = 'a' then Iter.empty else Iter.return 'a')
 let shrink_string = QCheck.Shrink.string ~shrink:shrink_char
 let shrink_bytes = QCheck.Shrink.bytes ~shrink:shrink_char
 
 let string = QCheck.(set_shrink shrink_string string)
-let string_small = QCheck.(set_shrink shrink_string small_string)
-let string_small_printable = QCheck.(set_shrink shrink_string small_printable_string)
+let string_small = QCheck.(set_shrink shrink_string string_small)
+let string_small_printable = QCheck.(set_shrink shrink_string (string_size_of Gen.nat_small
+                                                                Gen.char_printable))
 
 let bytes = QCheck.(set_shrink shrink_bytes bytes)
 let bytes_small = QCheck.(set_shrink shrink_bytes bytes_small)
@@ -175,11 +176,11 @@ let bytes_small_printable = QCheck.(set_shrink shrink_bytes (bytes_small_of Gen.
 let unit =           GenDeconstr (QCheck.unit,           QCheck.Print.unit, (=))
 let bool =           GenDeconstr (QCheck.bool,           QCheck.Print.bool, (=))
 let char =           GenDeconstr (QCheck.char,           QCheck.Print.char, (=))
-let char_printable = GenDeconstr (QCheck.printable_char, QCheck.Print.char, (=))
-let nat_small =      GenDeconstr (QCheck.small_nat,      QCheck.Print.int,  (=))
+let char_printable = GenDeconstr (QCheck.char_printable, QCheck.Print.char, (=))
+let nat_small =      GenDeconstr (QCheck.nat_small,      QCheck.Print.int,  (=))
 let int =            GenDeconstr (QCheck.int,            QCheck.Print.int,  (=))
-let int_small =      GenDeconstr (QCheck.small_int,      QCheck.Print.int,  (=))
-let int_pos =        GenDeconstr (QCheck.pos_int,        QCheck.Print.int,  (=))
+let int_small =      GenDeconstr (QCheck.int_small,      QCheck.Print.int,  (=))
+let int_pos =        GenDeconstr (QCheck.int_pos,        QCheck.Print.int,  (=))
 let int_bound b =    GenDeconstr (QCheck.int_bound b,    QCheck.Print.int,  (=))
 let int32 =          GenDeconstr (QCheck.int32,          QCheck.Print.int32,   Int32.equal)
 let int64 =          GenDeconstr (QCheck.int64,          QCheck.Print.int64,   Int64.equal)
@@ -208,8 +209,8 @@ let list : type a c s. (a, c, s, combinable) ty -> (a list, c, s, combinable) ty
 
 let list_small : type a c s. (a, c, s, combinable) ty -> (a list, c, s, combinable) ty =
   fun ty -> match ty with
-    | Gen (arb, print) -> Gen (QCheck.small_list arb, QCheck.Print.list print)
-    | GenDeconstr (arb, print, eq) -> GenDeconstr (QCheck.small_list arb, QCheck.Print.list print, List.equal eq)
+    | Gen (arb, print) -> Gen (QCheck.list_small arb, QCheck.Print.list print)
+    | GenDeconstr (arb, print, eq) -> GenDeconstr (QCheck.list_small arb, QCheck.Print.list print, List.equal eq)
     | Deconstr (print, eq) -> Deconstr (QCheck.Print.list print, List.equal eq)
 
 let array : type a c s. (a, c, s, combinable) ty -> (a array, c, s, combinable) ty =
@@ -220,8 +221,8 @@ let array : type a c s. (a, c, s, combinable) ty -> (a array, c, s, combinable)
 
 let array_small : type a c s. (a, c, s, combinable) ty -> (a array, c, s, combinable) ty =
   fun ty -> match ty with
-    | Gen (arb, print) -> Gen (QCheck.array_of_size QCheck.Gen.small_nat arb, QCheck.Print.array print)
-    | GenDeconstr (arb, print, eq) -> GenDeconstr (QCheck.array_of_size QCheck.Gen.small_nat arb, QCheck.Print.array print, Array.for_all2 eq)
+    | Gen (arb, print) -> Gen (QCheck.array_small arb, QCheck.Print.array print)
+    | GenDeconstr (arb, print, eq) -> GenDeconstr (QCheck.array_small arb, QCheck.Print.array print, Array.for_all2 eq)
     | Deconstr (print, eq) -> Deconstr (QCheck.Print.array print, Array.for_all2 eq)
 
 let seq_iteri f s =
@@ -259,8 +260,8 @@ let seq : type a c s. (a, c, s, combinable) ty -> (a Seq.t, c, s, combinable) ty
 
 let seq_small : type a c s. (a, c, s, combinable) ty -> (a Seq.t, c, s, combinable) ty =
   fun ty -> match ty with
-    | Gen (arb, print) -> Gen (arb_seq QCheck.Gen.small_nat arb, print_seq print)
-    | GenDeconstr (arb, print, eq) -> GenDeconstr (arb_seq QCheck.Gen.small_nat arb, print_seq print, seq_equal eq)
+    | Gen (arb, print) -> Gen (arb_seq QCheck.Gen.nat_small arb, print_seq print)
+    | GenDeconstr (arb, print, eq) -> GenDeconstr (arb_seq QCheck.Gen.nat_small arb, print_seq print, seq_equal eq)
     | Deconstr (print, eq) -> Deconstr (print_seq print, seq_equal eq)
 
 let state = State
@@ -441,7 +442,7 @@ module MakeCmd (ApiSpec : Spec) : Internal.CmdSpec with type t = ApiSpec.t = str
          let shrink = gen_shrinker_of_desc fdesc in
          return (Cmd { name ; args ; rty ; print ; shrink ; f }))) ApiSpec.api
 
-  let gen_cmd : cmd QCheck.Gen.t = QCheck.Gen.frequency api
+  let gen_cmd : cmd QCheck.Gen.t = QCheck.Gen.oneof_weighted api
 
   let show_cmd (Cmd { args ; print ; _ }) = print args
 

lib/lin_effect.ml

@@ -52,7 +52,7 @@ module Make_internal (Spec : Internal.CmdSpec [@alert "-internal"]) = struct
       | UserCmd c  -> Spec.show_cmd c
 
     let gen_cmd =
-      (Gen.frequency
+      (Gen.oneof_weighted
          [(3,Gen.return SchedYield);
           (5,Gen.map (fun c -> UserCmd c) Spec.gen_cmd)])
 

multicoretests.opam

@@ -22,7 +22,7 @@ bug-reports: "https://github.com/ocaml-multicore/multicoretests/issues"
 depends: [
   "dune" {>= "3.18"}
   "base-domains"
-  "qcheck-core" {>= "0.25"}
+  "qcheck-core" {>= "0.90"}
   "qcheck-lin" {= version}
   "qcheck-stm" {= version}
   "odoc" {with-doc}

qcheck-lin.opam

@@ -23,7 +23,7 @@ bug-reports: "https://github.com/ocaml-multicore/multicoretests/issues"
 depends: [
   "dune" {>= "3.18"}
   "ocaml" {>= "4.12"}
-  "qcheck-core" {>= "0.25"}
+  "qcheck-core" {>= "0.90"}
   "qcheck-multicoretests-util" {= version}
   "odoc" {with-doc}
 ]

qcheck-multicoretests-util.opam

@@ -15,7 +15,7 @@ bug-reports: "https://github.com/ocaml-multicore/multicoretests/issues"
 depends: [
   "dune" {>= "3.18"}
   "ocaml" {>= "4.12"}
-  "qcheck-core" {>= "0.25"}
+  "qcheck-core" {>= "0.90"}
   "odoc" {with-doc}
 ]
 build: [

qcheck-stm.opam

@@ -23,7 +23,7 @@ bug-reports: "https://github.com/ocaml-multicore/multicoretests/issues"
 depends: [
   "dune" {>= "3.18"}
   "ocaml" {>= "4.12"}
-  "qcheck-core" {>= "0.25"}
+  "qcheck-core" {>= "0.90"}
   "qcheck-multicoretests-util" {= version}
   "odoc" {with-doc}
 ]

src/array/lin_internal_tests.ml

@@ -37,7 +37,7 @@ struct
 
   let gen_cmd =
     let open QCheck.Gen in
-    let int = small_nat and char = printable in
+    let int = nat_small and char = printable in
     oneof
       [
         pure Length;

src/array/stm_tests.ml

@@ -54,8 +54,8 @@ struct
   let power_of_2s = Array.init 63 (fun i -> 1 lsl i)
 
   let arb_cmd s =
-    let int_gen = Gen.(frequency [1,small_nat; 5,int_bound (List.length s - 1)]) in
-    let elem_gen = Gen.oneofa power_of_2s in
+    let int_gen = Gen.(oneof_weighted [1,nat_small; 5,int_bound (List.length s - 1)]) in
+    let elem_gen = Gen.oneof_array power_of_2s in
     QCheck.make ~print:show_cmd (*~shrink:shrink_cmd*)
       Gen.(oneof
              [ return Length;

src/bigarray/stm_tests.ml

@@ -29,7 +29,7 @@ struct
   type sut   = (int, int_elt, c_layout) Array1.t
 
   let arb_cmd s =
-    let int_gen = Gen.(oneof [small_nat; int_bound (List.length s - 1)]) in
+    let int_gen = Gen.(oneof [nat_small; int_bound (List.length s - 1)]) in
     QCheck.make ~print:show_cmd (*~shrink:shrink_cmd*)
       Gen.(oneof
              [ return Size_in_bytes;

src/buffer/stm_tests.ml

@@ -47,7 +47,7 @@ struct
     | _ -> Iter.empty
 
   let arb_cmd s =
-    let int_gen,string_gen = Gen.(small_nat,small_string) in
+    let int_gen,string_gen = Gen.(nat_small,string_small) in
     QCheck.make ~print:show_cmd (*~shrink:shrink_cmd*)
       Gen.(oneof [return Contents;
                   return To_bytes;

src/bytes/stm_tests.ml

@@ -50,7 +50,7 @@ struct
     | _ -> Iter.empty
 
   let arb_cmd s =
-    let int_gen = Gen.(oneof [small_nat; int_bound (List.length s - 1)]) in
+    let int_gen = Gen.(oneof [nat_small; int_bound (List.length s - 1)]) in
     let char_gen = Gen.printable in
     QCheck.make ~print:show_cmd ~shrink:shrink_cmd
       Gen.(oneof

src/domain/domain_spawntree.ml

@@ -41,11 +41,11 @@ let gen max_height max_degree =
   let degree_gen = Gen.int_bound max_degree in
   Gen.sized_size height_gen @@ Gen.fix (fun rgen n ->
     match n with
-    | 0 -> Gen.oneofl [Incr;Decr]
+    | 0 -> Gen.oneof_list [Incr;Decr]
     | _ ->
       Gen.oneof
         [
-          Gen.oneofl [Incr;Decr];
+          Gen.oneof_list [Incr;Decr];
           Gen.map (fun ls -> Spawn ls) (Gen.list_size degree_gen (rgen (n-1)))
         ])
 

src/domain/stm_tests_dls.ml

@@ -26,7 +26,7 @@ struct
 
   let arb_cmd _s =
     let index = Gen.int_bound (length-1) in
-    let int_gen = Gen.small_nat in
+    let int_gen = Gen.nat_small in
     QCheck.make ~print:show_cmd
       Gen.(oneof
              [ map (fun i -> Get i) index;

src/dynarray/stm_tests.ml

@@ -184,14 +184,14 @@ module Dynarray_spec (Elem : Elem) = struct
     let open Gen in
     let arr_idx state = map (fun i -> I i) (int_bound (List.length state - 1)) in
     let elem = Elem.arb.gen in
-    let array elm_gen = Gen.array_size small_nat elm_gen in
-    let list elm_gen = Gen.list_size small_nat elm_gen in
+    let array elm_gen = Gen.array_small elm_gen in
+    let list elm_gen = Gen.list_small elm_gen in
     QCheck.make ~print:show_cmd ~shrink:shrink_cmd
-      (frequency
+      (oneof_weighted
         [ 5, return Create;
-          5, map2 (fun l x -> Make (l, x)) small_nat elem;
-          50, map2 (fun arr_idx elem_idx -> Get (arr_idx, elem_idx)) (arr_idx state) small_nat;
-          50, map3 (fun arr_idx elem_idx x -> Set (arr_idx, elem_idx, x)) (arr_idx state) small_nat elem;
+          5, map2 (fun l x -> Make (l, x)) nat_small elem;
+          50, map2 (fun arr_idx elem_idx -> Get (arr_idx, elem_idx)) (arr_idx state) nat_small;
+          50, map3 (fun arr_idx elem_idx x -> Set (arr_idx, elem_idx, x)) (arr_idx state) nat_small elem;
           50, map (fun i -> Is_empty i) (arr_idx state);
           50, map (fun i -> Length i) (arr_idx state);
           50, map (fun i -> Get_last i) (arr_idx state);
@@ -228,7 +228,7 @@ module Dynarray_spec (Elem : Elem) = struct
           50, map (fun i -> To_seq_rev_reentrant i) (arr_idx state);
           50, map (fun i -> Capacity i) (arr_idx state);
           50, map2 (fun i cap -> Ensure_capacity (i, cap)) (arr_idx state) nat;
-          50, map2 (fun i extra_cap -> Ensure_extra_capacity (i, extra_cap)) (arr_idx state) small_nat;
+          50, map2 (fun i extra_cap -> Ensure_extra_capacity (i, extra_cap)) (arr_idx state) nat_small;
           50, map (fun i -> Fit_capacity i) (arr_idx state);
           50, map2 (fun arr_i cap -> Set_capacity (arr_i, cap)) (arr_idx state) nat;
           33, map (fun arr_i -> Reset arr_i) (arr_idx state);
@@ -619,7 +619,7 @@ end
 
 module Int : Elem = struct
   type t = int
-  let arb = QCheck.small_int
+  let arb = QCheck.nat_small
   let pp = Format.pp_print_int
   let equal = Int.equal
   let show = snd STM.int

src/dynlink/lin_tests.ml

@@ -5,7 +5,7 @@
 open Lin
 
 (* Two libraries that should exist, one that should not *)
-let library_name = QCheck.Gen.oneofl ["libA.cma"; "libB.cma"; "libC.cma"]
+let library_name = QCheck.Gen.oneof_list ["libA.cma"; "libB.cma"; "libC.cma"]
 let arb_library = QCheck.make library_name
 let print_library l = QCheck.Print.string (Dynlink.adapt_filename l)
 

src/ephemeron/stm_tests_spec.ml

@@ -86,11 +86,11 @@ let cleanup _ = ()
 let arb_cmd s =
   let key =
     if s = []
-    then Gen.(map Int64.of_int small_int)
-    else Gen.(oneof [oneofl (List.map fst s); map Int64.of_int small_int]) in
-  let data = Gen.(map Int64.of_int small_int) in
+    then Gen.(map Int64.of_int nat_small)
+    else Gen.(oneof [oneof_list (List.map fst s); map Int64.of_int nat_small]) in
+  let data = Gen.(map Int64.of_int nat_small) in
   QCheck.make ~print:show_cmd
-    Gen.(frequency
+    Gen.(oneof_weighted
            [ 1,return Clear;
              2,map2 (fun k v -> Add (k, v)) key data;
              2,map  (fun k -> Remove k) key;

src/floatarray/stm_tests.ml

@@ -38,7 +38,7 @@ struct
   type sut = Float.Array.t
 
   let arb_cmd s =
-    let int_gen = Gen.(frequency [ (1,small_nat);
+    let int_gen = Gen.(oneof_weighted [ (1,nat_small);
                                    (7,int_bound (List.length s - 1)); ]) in
     let float_gen = Gen.float in
     QCheck.make ~print:show_cmd (*~shrink:shrink_cmd*)

src/gc/stm_tests_spec.ml

@@ -163,7 +163,7 @@ let init_state =
 let array_length = 8
 
 let alloc_cmds =
-  let int_gen = Gen.small_nat in
+  let int_gen = Gen.nat_small in
   let str_len_gen = Gen.(map (fun shift -> 1 lsl (shift-1)) (int_bound 14)) in (*[-1;13] ~ [0;1;...4096;8196] *)
   let str_gen = Gen.map (fun l -> String.make l 'x') str_len_gen in
   let list_gen = Gen.map (fun l -> List.init l (fun _ -> 'l')) Gen.nat in
@@ -226,9 +226,9 @@ let gc_cmds =
    else [1,Gen.return Compact])
   @ alloc_cmds
 
-let arb_cmd _s = QCheck.make ~print:show_cmd (Gen.frequency gc_cmds)
+let arb_cmd _s = QCheck.make ~print:show_cmd (Gen.oneof_weighted gc_cmds)
 
-let arb_alloc_cmd _s = QCheck.make ~print:show_cmd (Gen.frequency alloc_cmds)
+let arb_alloc_cmd _s = QCheck.make ~print:show_cmd (Gen.oneof_weighted alloc_cmds)
 
 let next_state n s = match n with
   | Stat        -> s

src/hashtbl/stm_tests.ml

@@ -67,7 +67,7 @@ struct
     let char =
       if s=[]
       then Gen.printable
-      else Gen.(oneof [oneofl (List.map fst s); printable]) in
+      else Gen.(oneof [oneof_list (List.map fst s); printable]) in
     let int = Gen.nat in
     QCheck.make ~print:show_cmd
       (Gen.oneof