Skip to content

Commit

Permalink
Update examples to new interface
Browse files Browse the repository at this point in the history
  • Loading branch information
n-osborne committed Apr 17, 2024
1 parent 7be046a commit 1fa1231
Show file tree
Hide file tree
Showing 13 changed files with 140 additions and 102 deletions.
13 changes: 6 additions & 7 deletions examples/README.md
Original file line number Diff line number Diff line change
Expand Up @@ -28,9 +28,8 @@ need to be visible.
The STM `postcond` function pattern match on the returned value encapsulated in
a `STM.ty`. As functions `add_l` and `add_r` both return the node that has been
added, we need to extend the `STM.ty` type with an encoding for
`Lwt_dllist.node`. We add this extension in the external module
`Lwt_dllist_incl` and pass it to the `--include` option of the `ortac
qcheck-stm` command.
`Lwt_dllist.node`. We add this extension in the configuration moduel for
Ortac/QCheckSTM.

The generated code can be found in `lwt_dllist_tests.ml`. You can run the test
either with `dune runtest examples/` or by directly running the compiled
Expand All @@ -40,7 +39,7 @@ Dune rules have been generated using the `dune-rules` plugin, providing the
`dune` subcommand:

```sh
$ ortac dune qcheck-stm lwt_dllist_spec "create ()" "int t" lwt_dllist_tests --include=lwt_dllist_incl --package=ortac-examples --with-stdout-to=dune.lwt_dllist.inc
$ ortac dune qcheck-stm lwt_dllist_spec.mli lwt_dllist_config.ml lwt_dllist_tests.ml --package=ortac-examples --with-stdout-to=dune.lwt_dllist.inc
```

## `varray` library
Expand All @@ -62,8 +61,8 @@ dune-generated `mli` files hidden in the `_build` folder.
Here again, as for the previous example, we need to include some code. That is
the extension of the `STM.ty` type. But also a `QCheck` generator for the `'a
elt` type, as some functions of the library take arguments of this type. You
can find these extensions in the `varray_incl.ml` and `varray_circular_incl.ml`
files.
can find these extensions in the `varray_config.ml` and
`varray_circular_config.ml` files.

The generated code can be found in the respective `varray*tests.ml` files. They
have been promoted in the source tree in order to be easily accessible for
Expand All @@ -74,6 +73,6 @@ following command for `varray_spec.mli` and an adapted version for
`varray_circular_spec.mli`:

```sh
$ ortac dune qcheck-stm varray_spec "make 42 'a'" "char t" varray_tests --include=varray_incl --package=ortac-examples --with-stdout-to=dune.varray.inc
$ ortac dune qcheck-stm varray_spec.mli varray_config.ml varray_tests.ml --package=ortac-examples --with-stdout-to=dune.varray.inc
```

16 changes: 6 additions & 10 deletions examples/dune.lwt_dllist.inc
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
; This file is generated by ortac dune qcheck-stm
; It contains the rules for generating and running QCheck-STM tests for lwt_dllist_spec
; It contains the rules for generating and running QCheck-STM tests for lwt_dllist_spec.mli
; It also contains the rule to generate itself, so you can edit this rule to
; change some options rather that running ortac on the command line again

Expand All @@ -18,11 +18,9 @@
ortac
dune
qcheck-stm
lwt_dllist_spec
"create ()"
"int t"
lwt_dllist_tests
--include=lwt_dllist_incl
lwt_dllist_spec.mli
lwt_dllist_config.ml
lwt_dllist_tests.ml
--package=ortac-examples
--with-stdout-to=dune.lwt_dllist.inc))))

Expand All @@ -43,14 +41,12 @@
ortac
qcheck-stm
%{dep:lwt_dllist_spec.mli}
"create ()"
"int t"
--include=lwt_dllist_incl
%{dep:lwt_dllist_config.ml}
--quiet)))))

(test
(name lwt_dllist_tests)
(modules lwt_dllist_tests lwt_dllist_incl)
(modules lwt_dllist_tests)
(libraries
lwt_dllist_spec
qcheck-stm.stm
Expand Down
16 changes: 6 additions & 10 deletions examples/dune.varray.inc
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
; This file is generated by ortac dune qcheck-stm
; It contains the rules for generating and running QCheck-STM tests for varray_spec
; It contains the rules for generating and running QCheck-STM tests for varray_spec.mli
; It also contains the rule to generate itself, so you can edit this rule to
; change some options rather that running ortac on the command line again

Expand All @@ -18,11 +18,9 @@
ortac
dune
qcheck-stm
varray_spec
"make 42 'a'"
"char t"
varray_tests
--include=varray_incl
varray_spec.mli
varray_config.ml
varray_tests.ml
--package=ortac-examples
--with-stdout-to=dune.varray.inc))))

Expand All @@ -43,14 +41,12 @@
ortac
qcheck-stm
%{dep:varray_spec.mli}
"make 42 'a'"
"char t"
--include=varray_incl
%{dep:varray_config.ml}
--quiet)))))

(test
(name varray_tests)
(modules varray_tests varray_incl)
(modules varray_tests)
(libraries
varray_spec
qcheck-stm.stm
Expand Down
16 changes: 6 additions & 10 deletions examples/dune.varray_circular.inc
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
; This file is generated by ortac dune qcheck-stm
; It contains the rules for generating and running QCheck-STM tests for varray_circular_spec
; It contains the rules for generating and running QCheck-STM tests for varray_circular_spec.mli
; It also contains the rule to generate itself, so you can edit this rule to
; change some options rather that running ortac on the command line again

Expand All @@ -18,11 +18,9 @@
ortac
dune
qcheck-stm
varray_circular_spec
"make 42 'a'"
"char t"
varray_circular_tests
--include=varray_circular_incl
varray_circular_spec.mli
varray_circular_config.ml
varray_circular_tests.ml
--package=ortac-examples
--with-stdout-to=dune.varray_circular.inc))))

Expand All @@ -43,14 +41,12 @@
ortac
qcheck-stm
%{dep:varray_circular_spec.mli}
"make 42 'a'"
"char t"
--include=varray_circular_incl
%{dep:varray_circular_config.ml}
--quiet)))))

(test
(name varray_circular_tests)
(modules varray_circular_tests varray_circular_incl)
(modules varray_circular_tests)
(libraries
varray_circular_spec
qcheck-stm.stm
Expand Down
13 changes: 13 additions & 0 deletions examples/lwt_dllist_config.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
open Lwt_dllist_spec

type sut = int t

let init_sut = create ()

module Ty = struct
type _ ty += Node : 'a ty -> 'a node ty

let node spec =
let ty, show = spec in
(Node ty, fun n -> Printf.sprintf "Node %s" (show (get n)))
end
8 changes: 0 additions & 8 deletions examples/lwt_dllist_incl.ml

This file was deleted.

6 changes: 5 additions & 1 deletion examples/lwt_dllist_tests.ml
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,11 @@ module Ortac_runtime = Ortac_runtime_qcheck_stm
module Spec =
struct
open STM
include Lwt_dllist_incl
type _ ty +=
| Node: 'a ty -> 'a node ty
let node spec =
let (ty, show) = spec in
((Node ty), (fun n -> Printf.sprintf "Node %s" (show (get n))))
type sut = int t
type cmd =
| Is_empty
Expand Down
26 changes: 26 additions & 0 deletions examples/varray_circular_config.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,26 @@
open Varray

type sut = char t

let init_sut = make 42 'a'

module Pp = struct
include Util.Pp

let pp_elt pp = pp
end

module Gen = struct
include QCheck.Gen

let int = small_signed_int
let elt gen = gen
end

module Ty = struct
type _ ty += Elt : 'a ty -> 'a elt ty

let elt spec =
let ty, show = spec in
(Elt ty, fun x -> Printf.sprintf "Elt %s" (show x))
end
27 changes: 0 additions & 27 deletions examples/varray_circular_incl.ml

This file was deleted.

24 changes: 23 additions & 1 deletion examples/varray_circular_tests.ml
Original file line number Diff line number Diff line change
Expand Up @@ -62,7 +62,29 @@ let proj e =
module Spec =
struct
open STM
include Varray_circular_incl
module QCheck =
struct
include QCheck
module Gen =
struct
include Gen
include QCheck.Gen
let int = small_signed_int
let elt gen = gen
end
end
module Util =
struct
module Pp =
struct include Util.Pp
include Util.Pp
let pp_elt pp = pp end
end
type _ ty +=
| Elt: 'a ty -> 'a elt ty
let elt spec =
let (ty, show) = spec in
((Elt ty), (fun x -> Printf.sprintf "Elt %s" (show x)))
type sut = char t
type cmd =
| Push_back of char elt
Expand Down
26 changes: 26 additions & 0 deletions examples/varray_config.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,26 @@
open Varray

type sut = char t

let init_sut = make 42 'a'

module Pp = struct
include Util.Pp

let pp_elt pp = pp
end

module Gen = struct
include QCheck.Gen

let int = small_signed_int
let elt gen = gen
end

module Ty = struct
type _ ty += Elt : 'a ty -> 'a elt ty

let elt spec =
let ty, show = spec in
(Elt ty, fun x -> Printf.sprintf "Elt %s" (show x))
end
27 changes: 0 additions & 27 deletions examples/varray_incl.ml

This file was deleted.

24 changes: 23 additions & 1 deletion examples/varray_tests.ml
Original file line number Diff line number Diff line change
Expand Up @@ -62,7 +62,29 @@ let proj e =
module Spec =
struct
open STM
include Varray_incl
module QCheck =
struct
include QCheck
module Gen =
struct
include Gen
include QCheck.Gen
let int = small_signed_int
let elt gen = gen
end
end
module Util =
struct
module Pp =
struct include Util.Pp
include Util.Pp
let pp_elt pp = pp end
end
type _ ty +=
| Elt: 'a ty -> 'a elt ty
let elt spec =
let (ty, show) = spec in
((Elt ty), (fun x -> Printf.sprintf "Elt %s" (show x)))
type sut = char t
type cmd =
| Push_back of char elt
Expand Down

0 comments on commit 1fa1231

Please sign in to comment.