Skip to content

Commit d78bb21

Browse files
xhtmlboixvw
xhtmlboi
and
xvw
committed
Add Test effect for acting on Time in test ctx
In Mini_yocaml (see [1]) time is incremented with each file write because the test framework does not add an effect to control time. This makes the status of artifact modification dates implicit and complicated to track. So rather than using an ad-hoc strategy, we add an effect, only in the test scope, to allow the test-level to control the time. [1] https://github.com/xvw/mini_yocaml/ Co-authored-by: xvw <[email protected]>
1 parent 3fdf6f5 commit d78bb21

3 files changed

Lines changed: 41 additions & 11 deletions

File tree

‎test/lib/fs.ml‎

Lines changed: 17 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -132,14 +132,16 @@ let rename name = function
132132

133133
type trace = { system : t; execution_trace : string list; mtime : int }
134134

135-
let system { system; _ } = system
136-
let execution_trace { execution_trace; _ } = execution_trace |> List.rev
137-
let create_trace system = { system; execution_trace = []; mtime = 0 }
135+
let trace_system { system; _ } = system
136+
let trace_execution { execution_trace; _ } = execution_trace |> List.rev
137+
let trace_mtime { mtime; _ } = mtime
138+
let create_trace ?(mtime = 0) system = { system; execution_trace = []; mtime }
138139

139140
let push_trace trace action =
140141
{ trace with execution_trace = action :: trace.execution_trace }
141142

142143
let update_system trace system = { trace with system }
144+
let increase_mtime trace amount = { trace with mtime = trace.mtime + amount }
143145

144146
let push_log trace level message =
145147
let level =
@@ -176,6 +178,11 @@ let push_write_file trace on path content =
176178
@@ Format.asprintf "[WRITE_FILE][%a][%a]%s" on_pp on Yocaml.Path.pp path
177179
content
178180

181+
type _ Effect.t += Yocaml_test_increase_time : int -> unit Effect.t
182+
183+
let increase_time amount =
184+
Yocaml.Eff.perform @@ Yocaml_test_increase_time amount
185+
179186
let run ~trace program input =
180187
let handler =
181188
let trace = ref trace in
@@ -187,6 +194,13 @@ let run ~trace program input =
187194
(fun (type a) (eff : a Effect.t) ->
188195
let open Yocaml.Eff in
189196
match eff with
197+
| Yocaml_test_increase_time amount ->
198+
Some
199+
(fun (k : (a, _) continuation) ->
200+
(* We do not track the execution here because it is not
201+
revelant for tests. *)
202+
let () = trace := increase_mtime !trace amount in
203+
continue k ())
190204
| Yocaml_failwith exn -> Some (fun _ -> Stdlib.raise exn)
191205
| Yocaml_log (level, message) ->
192206
Some

‎test/lib/fs.mli‎

Lines changed: 21 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -112,14 +112,30 @@ val name_of : item -> string
112112
type trace
113113
(** Describes a filesystem, used into the effect interpretation. *)
114114

115-
val create_trace : t -> trace
115+
val create_trace : ?mtime:int -> t -> trace
116116
(** [create_trace fs] build a new trace on top of a file system. *)
117117

118-
val system : trace -> t
119-
(** [system trace] returns the modified file system. *)
118+
val trace_system : trace -> t
119+
(** [trace_system trace] returns the modified file system. *)
120120

121-
val execution_trace : trace -> string list
122-
(** [execution_trace trace] get the instruction trace. *)
121+
val trace_execution : trace -> string list
122+
(** [trace_execution trace] get the instruction trace. *)
123+
124+
val trace_mtime : trace -> int
125+
(** [trace_mtime trace] get the current modification time of a trace. *)
126+
127+
(** {2 Additional effects}
128+
129+
Controlling time from a test is possible by defining additional effects. *)
130+
131+
type _ Effect.t +=
132+
| Yocaml_test_increase_time : int -> unit Effect.t
133+
(** An effect that allows to increase time. *)
134+
135+
val increase_time : int -> unit Yocaml.Eff.t
136+
(** [increase_time x] perform the effect [Yocaml_test_increase_time]. *)
137+
138+
(** {2 Run effectful program} *)
123139

124140
val run : trace:trace -> ('a -> 'b Yocaml.Eff.t) -> 'a -> trace * 'b
125141
(** [run ~trace program input] run a given [program] (with a given [input])

‎test/yocaml/deps_test.ml‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ let test_need_update_1 =
3636
let deps = Deps.from_list [ ~/[ "content"; "foo.md" ] ] in
3737
let program () = Deps.need_update deps ~/[ "_build"; "foo.html" ] in
3838
let mtrace, computed_action = Fs.run ~trace:mtrace program () in
39-
let computed_trace = Fs.execution_trace mtrace in
39+
let computed_trace = Fs.trace_execution mtrace in
4040
let () =
4141
check Testable.required_action "should be equal" Deps.Create
4242
computed_action
@@ -67,7 +67,7 @@ let test_need_update_2 =
6767
let deps = Deps.from_list [ ~/[ "content"; "foo.md" ] ] in
6868
let program () = Deps.need_update deps ~/[ "_build"; "foo.html" ] in
6969
let mtrace, computed_action = Fs.run ~trace:mtrace program () in
70-
let computed_trace = Fs.execution_trace mtrace in
70+
let computed_trace = Fs.trace_execution mtrace in
7171
let () =
7272
check Testable.required_action "should be equal" Deps.Nothing
7373
computed_action
@@ -104,7 +104,7 @@ let test_need_update_3 =
104104
let deps = Deps.from_list [ ~/[ "content"; "foo.md" ] ] in
105105
let program () = Deps.need_update deps ~/[ "_build"; "foo.html" ] in
106106
let mtrace, computed_action = Fs.run ~trace:mtrace program () in
107-
let computed_trace = Fs.execution_trace mtrace in
107+
let computed_trace = Fs.trace_execution mtrace in
108108
let () =
109109
check Testable.required_action "should be equal" Deps.Update
110110
computed_action

0 commit comments

Comments
 (0)