Source file `qcheck_stm.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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
type config = {
  interface_file : string;
  config_file : string option;
  ocaml_output : string option;
  library : string option;
  package_name : string option;
  dune_output : string option;
  module_prefix : string option;
  submodule : string option;
  fork_timeout : int option;
}

open Fmt

let get_optional proj suffix config =
  let default =
    str "%s_%s"
      Filename.(basename config.interface_file |> chop_extension)
      suffix
  in
  Option.value (proj config) ~default

let get_config_file = get_optional (fun cfg -> cfg.config_file) "config.ml"
let get_ocaml_output = get_optional (fun cfg -> cfg.ocaml_output) "tests.ml"

let msg ppf config =
  pf ppf
    "; This file is generated by ortac dune qcheck-stm@\n\
     ; It contains the rules for generating and running QCheck-STM tests for %s@\n"
    config.interface_file

let stanza k ppf config = pf ppf "@[<v 1>(%a)@]" k config
let stanza_rule k ppf config = pf ppf "%a@." (stanza k) config

let with_target k ppf config =
  let k ppf config = pf ppf "with-stdout-to@;%s@;%a" "%{targets}" k config in
  stanza k ppf config

let setenv var value k ppf =
  let k ppf config = pf ppf "setenv@;%s@;%s@;%a" var value k config in
  stanza k ppf

let action ppf k =
  let k ppf config = pf ppf "action@;%a" k config in
  stanza k ppf

let action_with_env var value ppf k =
  let k ppf = setenv var value k ppf in
  action ppf k

let rule ppf stanzas = pf ppf "rule@;%a" (concat stanzas)
let test ppf stanzas = pf ppf "test@;%a" (concat stanzas)
let run ppf args = pf ppf "run@;%a" (concat args)
let ortac ppf _ = pf ppf "ortac"
let qcheck_stm ppf _ = pf ppf "qcheck-stm"
let interface ppf config = pf ppf "%s" config.interface_file
let config_file ppf config = pf ppf "%s" (get_config_file config)
let runtest ppf _ = pf ppf "(alias runtest)"
let promote ppf _ = pf ppf "(mode promote)"

let name ppf config =
  pf ppf "(name %s)" (Filename.chop_extension @@ get_ocaml_output config)

let dep aux ppf config = pf ppf "%%{dep:%a}" aux config

let libraries =
  let library ppf config =
    pf ppf "%s@;"
      (Option.value config.library
         ~default:Filename.(basename config.interface_file |> chop_extension))
  in
  let k ppf config =
    pf ppf
      "libraries@ %aqcheck-stm.stm@ qcheck-stm.sequential@ \
       qcheck-multicoretests-util@ ortac-runtime-qcheck-stm"
      library config
  in
  stanza k

let package s ppf =
  let k ppf _ = pf ppf "package %s" s in
  stanza k ppf

let deps ppf = pf ppf "(deps@; %a)" (package "ortac-qcheck-stm")
let quiet ppf _ = pf ppf "--quiet"

let package config =
  match config.package_name with
  | None -> []
  | Some s -> [ (fun ppf _ -> pf ppf "(package %s)" s) ]

let targets_ml ppf config = pf ppf "(targets %s)" @@ get_ocaml_output config

let optional_argument s prj cfg =
  Option.to_list
  @@ Option.map (fun pref ppf _ -> pf ppf "%s=%s" s pref) (prj cfg)

let module_prefix =
  optional_argument "--module-prefix" (fun cfg -> cfg.module_prefix)

let submodule = optional_argument "--submodule" (fun cfg -> cfg.submodule)

let gen_ortac_rule ppf config =
  let args =
    ortac
    :: qcheck_stm
    :: dep interface
    :: dep config_file
    :: quiet
    :: module_prefix config
    @ submodule config
  in
  let run ppf = run ppf args in
  let run = stanza run in
  let action ppf =
    action_with_env "ORTAC_ONLY_PLUGIN" "qcheck-stm" ppf (with_target run)
  in
  let stanzas =
    [ runtest; promote ] @ package config @ [ deps; targets_ml; action ]
  in
  let rule ppf = rule ppf stanzas in
  stanza_rule rule ppf config

let gen_test_rule ppf config =
  let modules ppf config =
    pf ppf "(modules %s)" (Filename.chop_extension @@ get_ocaml_output config)
  in
  let run ppf =
    run ppf
      [
        (fun ppf _ -> pf ppf "%s" "%{test}"); (fun ppf _ -> pf ppf "--verbose");
      ]
  in
  let action ppf =
    match config.fork_timeout with
    | None -> action ppf (stanza run)
    | Some timeout ->
        action_with_env "ORTAC_QCHECK_STM_TIMEOUT" (string_of_int timeout) ppf
          (stanza run)
  in
  let test ppf =
    test ppf @@ [ name; modules; libraries ] @ package config @ [ action ]
  in
  stanza_rule test ppf config

let gen_dune_rules ppf config =
  let rules = [ msg; gen_ortac_rule; gen_test_rule ] in
  concat ~sep:cut rules ppf config