Repository: c-cube/qcheck
Pull request #247 (2022-06-10 18:16:56)

Add shrinking to char arbitraries
This PR adds shrinking to `char* arbitrary` generators.
In order to avoid shrinking a `numeral` char `'7'` into a non-numeral `char` it includes a dedicated shrinker.
The `printable` case is not broken by the existing `Shrink.char` shrinker.

To eat my own medicine, I then proceeded to add Generator, Shrinker, and Statistics tests
...only to find bugs :open_mouth: 
- it turns out the specification for `QCheck.Gen.printable` was wrong - it is nice to test it
- the distribution for `QCheck2.Gen.printable` revealed an off-by-one error in its internal `range` function, meaning that it would not produce, e.g., 'z'

jmid: I've refined the shrinker tests a bit to better exercise the expected behaviour.
In doing so, I noticed that in the range '!'-'&' (character codes 32-38) `QCheck2.printable` shrinks towards '!' (lower character codes) contradicting the documentation of shrinking towards 'a' (97). I therefore updated the documentation to match the behaviour better. I admit it is underspecified - but fully specifying the behaviour becomes unreadable, IMO.

Also updated the CHANGELOG, so this should be good to go.
jmid: @vch9 Can you take a quick look at this since it finds and fixes an issue with the `QCheck2.printable` generator? :pray: 
jmid: @vch9's comment made me realize that reusing the `char` shrinker for `Gen.printable` in QCheck(1)
would break for `'\n'` (char code 10) by shrinking to a non-printable character.
I've therefore committed an explicit `Shrink.char_printable` shrinker along with a few unit tests of the behaviour.

Looking at the code for `Gen.printable` in QCheck.ml I see the same approach of QCheck2 using a local array/table.
This makes me think that the right solution(tm) would be to shrink towards the `'a'` entry in this array (at index 97 - 32 or so).
This could be done for both QCheck and QCheck2 and would clear up the weird QCheck2 character code jumping that is hard to specify.
jmid: I've now simplified the definition of `QCheck2.Gen.printable`. 
This makes the behaviour simpler to specify, as we always shrink towards 'a'.
Bonuses:
- we don't need a list of `printable_chars`.
- this cuts 0.5 sec of the QCheck2 shrinker benchmark and reduces major GC runs slightly from 368 to 364.

I've also updated the tests and the CHANGELOG accordingly, so this should be good to go.

Patch:
diff --git a/CHANGELOG.md b/CHANGELOG.md
index b625d5a..8d94255 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -28,11 +28,15 @@
 
 - add a shrinker performance benchmark [#177](https://github.com/c-cube/qcheck/pull/177)
 
+- fix distribution of `QCheck2.printable` which would omit certain characters
+
 - shrinker changes
   - recursive list shrinker with better complexity
   - string shrinker reuses improved list shrinker and adds char shrinking
   - function shrinker now shrinks default entry first and benefits from list shrinker improvements
   - replacing the linear-time char shrinker with a faster one reusing the bisecting int shrinker algorithm
+  - add `Shrink.char_numeral` and `Shrink.char_printable`
+  - add shrinking for `char arbitrary`s `char`, `printable_char`, and `numeral_char`
 
 - documentation updates:
   - clarify upper bound inclusion in `Gen.int_bound` and `Gen.int_range`
@@ -42,6 +46,8 @@
   - fix documented size distribution for `arbitrary` generators
     `string_gen`, `string`, `printable_string`, `numeral_string`, `list`, and `array`
   - fix exception documentation for `check_result`, `check_cell_exn`, and `check_exn`
+  - fix documentation for the distribution of `Gen.printable` and `printable_char`
+  - fix documentation for the shrinking behaviour of `QCheck2.printable`
 
 - add environment variable `QCHECK_LONG_FACTOR` similar to `QCHECK_COUNT` [#220](https://github.com/c-cube/qcheck/pull/220)
 
diff --git a/src/core/QCheck.ml b/src/core/QCheck.ml
index b0aa99e..331fec8 100644
--- a/src/core/QCheck.ml
+++ b/src/core/QCheck.ml
@@ -696,12 +696,19 @@ module Shrink = struct
 
   let filter f shrink x = Iter.filter f (shrink x)
 
-  let char c =  match c with
-    | 'a' -> Iter.empty
-    | _ ->
+  let char_generic target c =
+    if c = target
+    then Iter.empty
+    else
       let c_code = Char.code c in
-      let a_code = Char.code 'a' in
-      Iter.map (fun diff -> Char.chr (a_code + diff)) (int (c_code - a_code))
+      let target_code = Char.code target in
+      Iter.map (fun diff -> Char.chr (target_code + diff)) (int (c_code - target_code))
+  let char = char_generic 'a'
+  let char_numeral = char_generic '0'
+
+  let char_printable = function
+    | '\n' -> char '~' (* treat '\n' (10) as '~' (126) to ensure a non-trivial, printable output *)
+    | c -> char c
 
   let option s x = match x with
     | None -> Iter.empty
@@ -1093,9 +1100,14 @@ let int64 =
   make ~print:(fun i -> Int64.to_string i ^ "L") ~small:small1
     ~shrink:Shrink.int64 Gen.ui64
 
-let char = make_scalar ~print:(sprintf "%C") Gen.char
-let printable_char = make_scalar ~print:(sprintf "%C") Gen.printable
-let numeral_char = make_scalar ~print:(sprintf "%C") Gen.numeral
+let small_char target c = abs ((Char.code c) - (Char.code target))
+
+let char =
+  make ~print:(sprintf "%C") ~small:(small_char 'a') ~shrink:Shrink.char Gen.char
+let printable_char =
+  make ~print:(sprintf "%C") ~small:(small_char 'a') ~shrink:Shrink.char_printable Gen.printable
+let numeral_char =
+  make ~print:(sprintf "%C") ~small:(small_char '0') ~shrink:Shrink.char_numeral Gen.numeral
 
 let string_gen_of_size size gen =
   make ~shrink:Shrink.string ~small:String.length
diff --git a/src/core/QCheck.mli b/src/core/QCheck.mli
index ab6dcf4..6924df3 100644
--- a/src/core/QCheck.mli
+++ b/src/core/QCheck.mli
@@ -388,7 +388,7 @@ module Gen : sig
   val char : char t
   (** Generates characters upto character code 255. *)
 
-  val printable : char t (** Generates printable ascii characters in the range 32 to 127 *)
+  val printable : char t (** Generates printable ascii characters - either '\n' or in the range 32 to 126, inclusive *)
 
   val numeral : char t (** Generates numeral characters. *)
 
@@ -691,6 +691,14 @@ module Shrink : sig
   (** Shrinks towards ['a'].
       @since 0.6 *)
 
+  val char_numeral : char t
+  (** Shrinks towards ['0'].
+      @since NEXT_RELEASE *)
+
+  val char_printable : char t
+  (** Shrinks towards ['a'] like [!char]. The output is also a printable character.
+      @since NEXT_RELEASE *)
+
   val int : int t
 
   val int32 : int32 t
@@ -1227,7 +1235,7 @@ val char : char arbitrary
 
 val printable_char : char arbitrary
 (** Uniformly distributed over a subset of printable ascii chars.
-    Ascii character codes 32 to 127.
+    Ascii character codes 32 to 126, inclusive - or ['\n'] with code 10.
   *)
 
 val numeral_char : char arbitrary
diff --git a/src/core/QCheck2.ml b/src/core/QCheck2.ml
index f95104f..647f8ef 100644
--- a/src/core/QCheck2.ml
+++ b/src/core/QCheck2.ml
@@ -649,7 +649,7 @@ module Gen = struct
   (** The first characters are the usual lower case alphabetical letters to help shrinking. *)
   let printable_chars : char list =
     (* Left and right inclusive *)
-    let range min max = List.init (max - min) (fun i -> char_of_int (i + min)) in
+    let range min max = List.init (max - min + 1) (fun i -> char_of_int (i + min)) in
     let a = 97 in
     let z = 122 in
     let lower_alphabet = range a z in
diff --git a/src/core/QCheck2.mli b/src/core/QCheck2.mli
index c32627d..fee3fd9 100644
--- a/src/core/QCheck2.mli
+++ b/src/core/QCheck2.mli
@@ -280,7 +280,7 @@ module Gen : sig
     - [32] to [126], inclusive
     - ['\n']
 
-    Shrinks towards ['a'].
+    Shrinks towards ['a'] or lower character codes.
   *)
 
   val numeral : char t


Test patch:
diff --git a/test/core/QCheck2_expect_test.expected b/test/core/QCheck2_expect_test.expected
index c317182..64b857e 100644
--- a/test/core/QCheck2_expect_test.expected
+++ b/test/core/QCheck2_expect_test.expected
@@ -334,6 +334,18 @@ Test char never produces 'abcdef' failed (1 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
+Test printable never produces '!"#$%&'' failed (1 shrink steps):
+
+'!'
+
+--- Failure --------------------------------------------------------------------
+
+Test printable never produces less than '5 failed (1 shrink steps):
+
+'0'
+
+--- Failure --------------------------------------------------------------------
+
 Test strings are empty failed (8 shrink steps):
 
 "a"
@@ -643,6 +655,46 @@ stats char code:
   234..246: ######################################################        25567
   247..259: #####################################                         17709
 
++++ Stats for printable char code dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+stats char code:
+  num: 500000, avg: 78.26, stddev: 28.15, median 78, min 10, max 126
+   10.. 15: #########                                                      5149
+   16.. 21:                                                                   0
+   22.. 27:                                                                   0
+   28.. 33: ##################                                            10379
+   34.. 39: ######################################################        31153
+   40.. 45: ######################################################        31341
+   46.. 51: ######################################################        31408
+   52.. 57: #######################################################       31456
+   58.. 63: ######################################################        31310
+   64.. 69: ######################################################        31152
+   70.. 75: ######################################################        31308
+   76.. 81: ######################################################        31156
+   82.. 87: ######################################################        31170
+   88.. 93: ######################################################        31286
+   94.. 99: ######################################################        31364
+  100..105: ######################################################        31368
+  106..111: ######################################################        31024
+  112..117: ######################################################        31261
+  118..123: ######################################################        31064
+  124..129: ###########################                                   15651
+
++++ Stats for numeral char code dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+stats char code:
+  num: 500000, avg: 52.50, stddev: 2.87, median 52, min 48, max 57
+  48: ######################################################        50260
+  49: ######################################################        49590
+  50: ######################################################        50170
+  51: #######################################################       50270
+  52: ######################################################        49805
+  53: ######################################################        50161
+  54: ######################################################        49919
+  55: ######################################################        49971
+  56: ######################################################        49980
+  57: ######################################################        49874
+
 +++ Stats for tree's depth ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
 stats depth:
@@ -1274,7 +1326,7 @@ stats dist:
    4150517416584649600.. 4611686018427387903: #################                                               189
 ================================================================================
 1 warning(s)
-failure (58 tests failed, 3 tests errored, ran 127 tests)
+failure (60 tests failed, 3 tests errored, ran 131 tests)
 random seed: 153870556
 
 +++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
diff --git a/test/core/QCheck2_tests.ml b/test/core/QCheck2_tests.ml
index f9c07e5..24954db 100644
--- a/test/core/QCheck2_tests.ml
+++ b/test/core/QCheck2_tests.ml
@@ -181,6 +181,14 @@ module Generator = struct
     Test.make ~name:"char has right range'" ~count:1000 ~print:Print.char
       Gen.char (fun c -> '\000' <= c && c <= '\255')
 
+  let printable_test =
+    Test.make ~name:"printable has right range" ~count:1000 ~print:Print.char
+      Gen.printable (fun c -> c = '\n' || 32 <= Char.code c && Char.code c <= 126)
+
+  let numeral_test =
+    Test.make ~name:"numeral has right range" ~count:1000 ~print:Print.char
+      Gen.numeral (fun c -> '0' <= c && c <= '9')
+
   let nat_test =
     Test.make ~name:"nat has right range" ~count:1000 ~print:Print.int
       Gen.nat (fun n -> 0 <= n && n < 10000)
@@ -370,6 +378,14 @@ module Shrink = struct
     Test.make ~name:"char never produces 'abcdef'" ~count:1000 ~print:Print.char
       Gen.char (fun c -> not (List.mem c ['a';'b';'c';'d';'e';'f']))
 
+  let printable_is_never_sign = (* should shrink towards '!' with lowest ascii code 33 *)
+    Test.make ~name:"printable never produces '!\"#$%&''" ~count:1000 ~print:Print.char
+      Gen.printable (fun c -> not (List.mem c ['!';'@';'#';'$';'%']))
+
+  let numeral_is_never_less_5 =
+    Test.make ~name:"printable never produces less than '5" ~count:1000 ~print:Print.char
+      Gen.numeral (fun c -> c >= '5')
+
   let strings_are_empty =
     Test.make ~name:"strings are empty" ~count:1000 ~print:Print.string
       Gen.string (fun s -> s = "")
@@ -581,6 +597,8 @@ module Shrink = struct
     ints_smaller_209609;
     nats_smaller_5001;
     char_is_never_abcdef;
+    printable_is_never_sign;
+    numeral_is_never_less_5;
     strings_are_empty;
     string_never_has_000_char;
     string_never_has_255_char;
@@ -745,8 +763,12 @@ module Stats = struct
   let bool_dist =
     Test.make ~name:"bool dist" ~count:500_000 ~collect:Bool.to_string Gen.bool (fun _ -> true)
 
-  let char_dist =
-    Test.make ~name:"char code dist" ~count:500_000 ~stats:[("char code", Char.code)] Gen.char (fun _ -> true)
+  let char_dist_tests =
+    [
+    Test.make ~name:"char code dist"           ~count:500_000 ~stats:[("char code", Char.code)] Gen.char      (fun _ -> true);
+    Test.make ~name:"printable char code dist" ~count:500_000 ~stats:[("char code", Char.code)] Gen.printable (fun _ -> true);
+    Test.make ~name:"numeral char code dist"   ~count:500_000 ~stats:[("char code", Char.code)] Gen.numeral   (fun _ -> true);
+  ]
 
   let string_len_tests =
     let len = ("len",String.length) in
@@ -819,9 +841,9 @@ module Stats = struct
       Gen.(oneof [small_int_corners ();int]) (fun _ -> true)
 
   let tests =
-    [ bool_dist;
-      char_dist;
-      tree_depth_test;]
+    [ bool_dist; ]
+    @ char_dist_tests
+    @ [ tree_depth_test;]
     @ string_len_tests
     @ [pair_dist;
        triple_dist;
diff --git a/test/core/QCheck2_unit_tests.ml b/test/core/QCheck2_unit_tests.ml
index 8711971..6624fdd 100644
--- a/test/core/QCheck2_unit_tests.ml
+++ b/test/core/QCheck2_unit_tests.ml
@@ -1,5 +1,18 @@
 open QCheck2
 
+let rand_init i = Random.State.make [|i|]
+
+let rec repeated_success t =
+  Tree.root t :: match Tree.children t () with
+  | Seq.Nil -> []
+  | Seq.Cons (t,_) -> repeated_success t
+
+let repeated_failure t =
+  Tree.root t :: match Tree.children t () with
+  | Seq.Nil -> []
+  | Seq.Cons (t,ts) -> Tree.root t :: (Seq.map Tree.root ts |> List.of_seq)
+
+
 module Shrink = struct
   let test_int_towards () =
     Alcotest.(check' (list int))
@@ -57,11 +70,68 @@ module Shrink = struct
       ~actual:(Shrink.float_towards (-50.) (-26.) |> List.of_seq)
       ~expected:[-50.; -38.; -32.; -29.; -27.5; -26.75; -26.375; -26.1875; -26.0938; -26.0469; -26.0234; -26.0117; -26.0059; -26.0029; -26.0015]
 
+  let test_char () =
+    Alcotest.(check' (list char))
+    ~msg:"'k' on repeated failure"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 1234) char) |> repeated_failure)
+    ~expected:['k'; 'a'; 'f'; 'h'; 'i'; 'j'];
+    Alcotest.(check' (list char))
+    ~msg:"'1' on repeated failure"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 3345) char) |> repeated_failure)
+    ~expected:['1'; 'a'; 'I'; '='; '7'; '4'; '2'];
+    Alcotest.(check' (list char))
+    ~msg:"'k' on repeated success"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 1234) char) |> repeated_success)
+    ~expected:['k'; 'a';];
+    Alcotest.(check' (list char))
+    ~msg:"'1' on repeated success"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 3345) char) |> repeated_success)
+    ~expected:['1'; 'a';]
+
+  let test_char_numeral () =
+    Alcotest.(check' (list char))
+    ~msg:"'3' on repeated failure"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 1234) numeral) |> repeated_failure)
+    ~expected:['3'; '0'; '1'; '2'];
+    Alcotest.(check' (list char))
+    ~msg:"'0' on repeated failure"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 3346) numeral) |> repeated_failure)
+    ~expected:['0'];
+    Alcotest.(check' (list char))
+    ~msg:"'3' on repeated success"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 1234) numeral) |> repeated_success)
+    ~expected:['3'; '0';];
+    Alcotest.(check' (list char))
+    ~msg:"'0' on repeated success"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 3346) numeral) |> repeated_success)
+    ~expected:['0';]
+
+  let test_char_printable () =
+    Alcotest.(check' (list char))
+    ~msg:"'l' on repeated failure"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 1234) printable) |> repeated_failure)
+    ~expected:['l'; 'a'; 'f'; 'i'; 'j'; 'k'];
+    Alcotest.(check' (list char))
+    ~msg:"'8' on repeated failure"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 3346) printable) |> repeated_failure)
+    ~expected:['8'; 'a'; 'z'; ','; '2'; '5'; '7'];
+    Alcotest.(check' (list char))
+    ~msg:"'l' on repeated success"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 1234) printable) |> repeated_success)
+    ~expected:['l'; 'a';];
+    Alcotest.(check' (list char))
+    ~msg:"'8' on repeated success"
+    ~actual:(Gen.(generate_tree ~rand:(rand_init 3346) printable) |> repeated_success)
+    ~expected:['8'; 'a';]
+
   let tests = ("Shrink", Alcotest.[
       test_case "int_towards" `Quick test_int_towards;
       test_case "int32_towards" `Quick test_int32_towards;
       test_case "int64_towards" `Quick test_int64_towards;
-      test_case "float_towards" `Quick test_float_towards
+      test_case "float_towards" `Quick test_float_towards;
+      test_case "Gen.char tree" `Quick test_char;
+      test_case "Gen.numeral tree" `Quick test_char_numeral;
+      test_case "Gen.printable tree" `Quick test_char_printable;
     ])
 end
 
diff --git a/test/core/QCheck_expect_test.expected b/test/core/QCheck_expect_test.expected
index 2d3d7f0..3d828e7 100644
--- a/test/core/QCheck_expect_test.expected
+++ b/test/core/QCheck_expect_test.expected
@@ -266,9 +266,21 @@ Test nat < 5001 failed (6 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test char never produces 'abcdef' failed (0 shrink steps):
+Test char never produces 'abcdef' failed (3 shrink steps):
 
-'d'
+'a'
+
+--- Failure --------------------------------------------------------------------
+
+Test printable never produces '!"#$%&' failed (2 shrink steps):
+
+'&'
+
+--- Failure --------------------------------------------------------------------
+
+Test printable never produces less than '5 failed (3 shrink steps):
+
+'0'
 
 --- Failure --------------------------------------------------------------------
 
@@ -581,6 +593,46 @@ stats char code:
   234..246: ######################################################        25567
   247..259: #####################################                         17709
 
++++ Stats for printable char code dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+stats char code:
+  num: 500000, avg: 77.76, stddev: 27.92, median 78, min 10, max 125
+   10.. 15: #########                                                      5392
+   16.. 21:                                                                   0
+   22.. 27:                                                                   0
+   28.. 33: ##################                                            10661
+   34.. 39: ######################################################        31788
+   40.. 45: ######################################################        31217
+   46.. 51: #######################################################       31790
+   52.. 57: ######################################################        31625
+   58.. 63: ######################################################        31421
+   64.. 69: ######################################################        31732
+   70.. 75: ######################################################        31446
+   76.. 81: ######################################################        31382
+   82.. 87: ######################################################        31623
+   88.. 93: ######################################################        31730
+   94.. 99: #####################################################         31193
+  100..105: ######################################################        31424
+  106..111: ######################################################        31675
+  112..117: ######################################################        31651
+  118..123: ######################################################        31682
+  124..129: ##################                                            10568
+
++++ Stats for numeral char code dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+stats char code:
+  num: 500000, avg: 52.50, stddev: 2.87, median 52, min 48, max 57
+  48: ######################################################        50260
+  49: ######################################################        49590
+  50: ######################################################        50170
+  51: #######################################################       50270
+  52: ######################################################        49805
+  53: ######################################################        50161
+  54: ######################################################        49919
+  55: ######################################################        49971
+  56: ######################################################        49980
+  57: ######################################################        49874
+
 +++ Stats for tree's depth ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
 stats depth:
@@ -1238,7 +1290,7 @@ stats dist:
    4150517416584649600.. 4611686018427387903: #################                                               189
 ================================================================================
 1 warning(s)
-failure (58 tests failed, 3 tests errored, ran 134 tests)
+failure (60 tests failed, 3 tests errored, ran 140 tests)
 random seed: 153870556
 
 +++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
diff --git a/test/core/QCheck_tests.ml b/test/core/QCheck_tests.ml
index e00dd07..805b28c 100644
--- a/test/core/QCheck_tests.ml
+++ b/test/core/QCheck_tests.ml
@@ -186,9 +186,17 @@ module Generator = struct
     Test.make ~name:"char never produces '\\255'" ~count:1_000_000 char (fun c -> c <> '\255')
 
   let char_test =
-    Test.make ~name:"char has right range'" ~count:1000
+    Test.make ~name:"char has right range" ~count:1000
       char (fun c -> '\000' <= c && c <= '\255')
 
+  let printable_test =
+    Test.make ~name:"printable has right range" ~count:1000
+      printable_char (fun c -> c = '\n' || 32 <= Char.code c && Char.code c <= 126)
+
+  let numeral_test =
+    Test.make ~name:"numeral has right range" ~count:1000
+      numeral_char (fun c -> '0' <= c && c <= '9')
+
   let nat_test =
     Test.make ~name:"nat has right range" ~count:1000
       (make ~print:Print.int Gen.nat) (fun n -> 0 <= n && n < 10000)
@@ -378,6 +386,8 @@ module Generator = struct
   let tests = [
     char_dist_issue_23;
     char_test;
+    printable_test;
+    numeral_test;
     nat_test;
     string_test;
     pair_test;
@@ -454,6 +464,14 @@ module Shrink = struct
     Test.make ~name:"char never produces 'abcdef'" ~count:1000
       char (fun c -> not (List.mem c ['a';'b';'c';'d';'e';'f']))
 
+  let printable_is_never_sign = (* should shrink towards 'a', hence produce '&' with highest ascii code 38 *)
+    Test.make ~name:"printable never produces '!\"#$%&'" ~count:1000
+      printable_char (fun c -> not (List.mem c ['!';'"';'#';'$';'%';'&']))
+
+  let numeral_is_never_less_5 =
+    Test.make ~name:"printable never produces less than '5" ~count:1000
+      numeral_char (fun c -> c >= '5')
+
   let strings_are_empty =
     Test.make ~name:"strings are empty" ~count:1000
       string (fun s -> s = "")
@@ -656,6 +674,8 @@ module Shrink = struct
     ints_smaller_209609;
     nats_smaller_5001;
     char_is_never_abcdef;
+    printable_is_never_sign;
+    numeral_is_never_less_5;
     strings_are_empty;
     string_never_has_000_char;
     string_never_has_255_char;
@@ -815,8 +835,12 @@ module Stats = struct
   let bool_dist =
     Test.make ~name:"bool dist" ~count:500_000 (set_collect Bool.to_string bool) (fun _ -> true)
 
-  let char_dist =
-    Test.make ~name:"char code dist" ~count:500_000 (add_stat ("char code", Char.code) char) (fun _ -> true)
+  let char_dist_tests =
+    [
+      Test.make ~name:"char code dist"           ~count:500_000 (add_stat ("char code", Char.code) char)           (fun _ -> true);
+      Test.make ~name:"printable char code dist" ~count:500_000 (add_stat ("char code", Char.code) printable_char) (fun _ -> true);
+      Test.make ~name:"numeral char code dist"   ~count:500_000 (add_stat ("char code", Char.code) numeral_char)   (fun _ -> true);
+    ]
 
   let string_len_tests =
     let len = ("len",String.length) in
@@ -896,10 +920,10 @@ module Stats = struct
       (add_stat ("dist",fun x -> x) (oneof [small_int_corners ();int])) (fun _ -> true)
 
   let tests =
-    [ bool_dist;
-      char_dist;
-      tree_depth_test;
-      range_subset_test;]
+    [ bool_dist; ]
+    @ char_dist_tests
+    @ [tree_depth_test;
+       range_subset_test;]
     @ string_len_tests
     @ [pair_dist;
        triple_dist;
diff --git a/test/core/QCheck_unit_tests.ml b/test/core/QCheck_unit_tests.ml
index 95d3f15..1e648ff 100644
--- a/test/core/QCheck_unit_tests.ml
+++ b/test/core/QCheck_unit_tests.ml
@@ -15,7 +15,7 @@ module Shrink = struct
     loop x
 
   let alco_check typ func msg_suffix (msg,input,expected) =
-    Alcotest.(check (list typ)) (msg ^ " - " ^ msg_suffix) (func input) expected
+    Alcotest.(check (list typ)) (msg ^ " - " ^ msg_suffix) expected (func input)
 
   let test_int () =
     List.iter (alco_check Alcotest.int (trace_false Shrink.int) "on repeated failure")
@@ -47,10 +47,47 @@ module Shrink = struct
         ("int 1000",  1000L, [500L; 250L; 125L; 63L; 32L; 16L; 8L; 4L; 2L; 1L; 0L]);
         ("int (-26)", -26L,  [-13L; -7L; -4L; -2L; -1L; 0L]) ]
 
+  let test_char () =
+    List.iter (alco_check Alcotest.char (trace_false Shrink.char) "on repeated failure")
+      [ ("char 'a'",   'a',  []);
+        ("char 'z'",   'z',  ['n'; 't'; 'w'; 'y'; 'y']); (*WTF?*)
+        ("char 'A'",   'A',  ['Q'; 'I'; 'E'; 'C'; 'B']);
+        ("char '~'",   '~',  ['p'; 'w'; '{'; '}'; '}']) ]; (*WTF?*)
+    List.iter (alco_check Alcotest.char (trace_true Shrink.char) "on repeated success")
+      [ ("char 'a'",   'a',  []);
+        ("char 'z'",   'z',  ['n'; 'h'; 'e'; 'c'; 'b'; 'a']);
+        ("char 'A'",   'A',  ['Q'; 'Y'; ']'; '_'; '`'; 'a']);
+        ("char '~'",   '~',  ['p'; 'i'; 'e'; 'c'; 'b'; 'a']); ]
+
+  let test_char_numeral () =
+    List.iter (alco_check Alcotest.char (trace_false Shrink.char_numeral) "on repeated failure")
+      [ ("char '0'",   '0',  []);
+        ("char '9'",   '9',  ['5'; '7'; '8']) ];
+    List.iter (alco_check Alcotest.char (trace_true Shrink.char_numeral) "on repeated success")
+      [ ("char '0'",   '0',  []);
+        ("char '9'",   '9',  ['5'; '3'; '2'; '1'; '0']); ]
+
+  let test_char_printable () =
+    List.iter (alco_check Alcotest.char (trace_false Shrink.char_printable) "on repeated failure")
+      [ ("char 'A'",   'A',  ['Q'; 'I'; 'E'; 'C'; 'B']);
+        ("char 'a'",   'a',  []);
+        ("char ' '",   ' ',  ['@'; '0'; '('; '$'; '"'; '!']);
+        ("char '~'",   '~',  ['p'; 'w'; '{'; '}'; '}']); (*WTF?*)
+        ("char '\\n'", '\n', ['p'; 'w'; '{'; '}'; '}']); ]; (*WTF?*)
+    List.iter (alco_check Alcotest.char (trace_true Shrink.char_printable) "on repeated success")
+      [ ("char 'A'",   'A',  ['Q'; 'Y'; ']'; '_'; '`'; 'a']);
+        ("char 'a'",   'a',  []);
+        ("char ' '",   ' ',  ['@'; 'P'; 'X'; '\\'; '^'; '_'; '`'; 'a']);
+        ("char '~'",   '~',  ['p'; 'i'; 'e'; 'c'; 'b'; 'a']);
+        ("char '\\n'", '\n', ['p'; 'i'; 'e'; 'c'; 'b'; 'a']); ]
+
   let tests = ("Shrink", Alcotest.[
       test_case "int"   `Quick test_int;
       test_case "int32" `Quick test_int32;
       test_case "int64" `Quick test_int64;
+      test_case "char"  `Quick test_char;
+      test_case "char_numeral"   `Quick test_char_numeral;
+      test_case "char_printable" `Quick test_char_printable;
     ])
 end