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
open Utils

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;
  domain : bool;
  count : int;
  fork_timeout : int option;
  gen_alias : string option;
  run_alias : string 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 qcheck_stm ppf _ = pf ppf "qcheck-stm"

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 interface ppf config = pf ppf "%s" config.interface_file
let config_file ppf config = pf ppf "%s" (get_config_file config)

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

let public_name ppf config =
  pf ppf "(public_name %s)" (Filename.chop_extension @@ get_ocaml_output 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 =
    let backend = if config.domain then "domain" else "sequential" in
    pf ppf
      "libraries@ %aqcheck-stm.stm@ qcheck-stm.%s@ qcheck-multicoretests-util@ \
       ortac-runtime-qcheck-stm.%s"
      library config backend backend
  in
  stanza k

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

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

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

let submodule = optional_argument "--submodule" (fun cfg -> cfg.submodule)
let domain cfg = if cfg.domain then [ (fun ppf _ -> pf ppf "--domain") ] else []
let count cfg ppf _ = pf ppf "--count=%i" cfg.count

let gen_alias config =
  let alias = Option.value config.gen_alias ~default:"runtest" in
  fun ppf _ -> pf ppf "(alias %s)" alias

let run_alias config =
  let alias = Option.value config.run_alias ~default:"runtest" in
  fun ppf _ -> pf ppf "(alias %s)" alias

let gen_ortac_rule ppf config =
  let args =
    ortac
    :: qcheck_stm
    :: dep interface
    :: dep config_file
    :: quiet
    :: count config
    :: module_prefix config
    @ domain 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 =
    [ gen_alias config; promote ]
    @ package config
    @ [ deps_pkg; targets get_ocaml_output; action ]
  in
  let rule ppf = rule ppf stanzas in
  stanza_rule rule ppf config

let gen_test_exe ppf config =
  let modules ppf config =
    pf ppf "(modules %s)" (Filename.chop_extension @@ get_ocaml_output config)
  in
  let test ppf =
    exe ppf @@ (name :: public_name :: package config) @ [ modules; libraries ]
  in
  stanza_rule test ppf config

let gen_test_run ppf config =
  let run ppf =
    run ppf
      [
        (fun ppf _ ->
          pf ppf "%%{dep:%s.exe}"
            (Filename.chop_extension @@ get_ocaml_output config));
        (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 stanzas = (run_alias config :: package config) @ [ action ] in
  let rule ppf = rule ppf stanzas in
  stanza_rule rule ppf config

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