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
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;
  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 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 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 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 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_pkg; targets get_ocaml_output; 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