package base_quickcheck

  1. Overview
  2. Docs
Randomized testing framework, designed for compatibility with Base

Install 

dune-project
 Dependency

github.com MIT License Edit opam file Versions (9)

Authors

  1. J
    Jane Street Group, LLC

Maintainers

  1. J
    Jane Street developers

Sources

v0.14.1.tar.gz
sha256=b69a18bf0149e3b553ada9af5258681000948bfb7b6646fee66aa462b507b058
md5=d04738d4499e256b752bc40fcdb9730d

doc/src/ppx_quickcheck_expander/ppx_shrinker_expander.ml.html

Source file ppx_shrinker_expander.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
open! Import

let any ~loc = [%expr Base_quickcheck.Shrinker.atomic]
let arrow ~loc = [%expr Base_quickcheck.Shrinker.atomic]

let compound_sequence ~loc ~make_compound_expr ~field_pats ~field_exprs ~shrinker_exprs =
  [%expr
    Base.Sequence.round_robin
      [%e
        elist
          ~loc
          (List.map3_exn
             field_pats
             field_exprs
             shrinker_exprs
             ~f:(fun field_pat field_expr shrinker ->
               let loc = { shrinker.pexp_loc with loc_ghost = true } in
               [%expr
                 Base.Sequence.map
                   (Base_quickcheck.Shrinker.shrink [%e shrinker] [%e field_expr])
                   ~f:(fun [%p field_pat] -> [%e make_compound_expr ~loc field_exprs])]))]]
;;

let compound
      (type field)
      ~shrinker_of_core_type
      ~loc
      ~fields
      (module Field : Field_syntax.S with type ast = field)
  =
  let fields = List.map fields ~f:Field.create in
  let field_pats, field_exprs = gensyms "x" (List.map fields ~f:Field.location) in
  let shrinker_exprs =
    List.map fields ~f:(fun field -> shrinker_of_core_type (Field.core_type field))
  in
  [%expr
    Base_quickcheck.Shrinker.create (fun [%p Field.pattern fields ~loc field_pats] ->
      [%e
        compound_sequence
          ~loc
          ~make_compound_expr:(Field.expression fields)
          ~field_pats
          ~field_exprs
          ~shrinker_exprs])]
;;

let variant
      (type clause)
      ~shrinker_of_core_type
      ~loc
      ~variant_type
      ~clauses
      (module Clause : Clause_syntax.S with type ast = clause)
  =
  let clauses = Clause.create_list clauses in
  [%expr
    Base_quickcheck.Shrinker.create
      [%e
        pexp_function
          ~loc
          (List.map clauses ~f:(fun clause ->
             let loc = { (Clause.location clause) with loc_ghost = true } in
             let core_type_list = Clause.core_type_list clause in
             let field_pats, field_exprs =
               gensyms
                 "x"
                 (List.map core_type_list ~f:(fun core_type -> core_type.ptyp_loc))
             in
             let shrinker_exprs = List.map core_type_list ~f:shrinker_of_core_type in
             let lhs = Clause.pattern clause ~loc field_pats in
             let rhs =
               compound_sequence
                 ~loc
                 ~make_compound_expr:(Clause.expression clause variant_type)
                 ~field_pats
                 ~field_exprs
                 ~shrinker_exprs
             in
             case ~lhs ~guard:None ~rhs))]]
;;