This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions

View file

@ -0,0 +1,12 @@
open Dune_action_plugin.V1
let action =
let open O in
let path_to_dependency = read_file ~path:(Path.of_string "foo_or_bar") in
path_to_dependency
|> stage ~f:(fun path_to_dependency ->
let+ data = read_file ~path:(Path.of_string path_to_dependency) in
print_endline data)
;;
let () = run action

View file

@ -0,0 +1,7 @@
(executables
(names simple_concatenation choosing_dependency)
(libraries dune_action_plugin))
(alias
(name examples)
(deps simple_concatenation.exe))

View file

@ -0,0 +1,12 @@
open Dune_action_plugin.V1
let action =
let source1 = read_file ~path:(Path.of_string "source1")
and source2 = read_file ~path:(Path.of_string "source2") in
both source1 source2
|> stage ~f:(fun (source1, source2) ->
let data = source1 ^ source2 in
write_file ~path:(Path.of_string "target") ~data)
;;
let () = run action

View file

@ -0,0 +1,6 @@
(library
(name dune_action_plugin)
(public_name dune-action-plugin)
(libraries stdune csexp dune-glob unix dune-rpc.private)
(synopsis
"[Internal] Monadic interface for defining scripts with dynamic or complex sets of dependencies."))

View file

@ -0,0 +1,211 @@
open Import
module V1 = struct
module Path = Path
module Glob = Dune_glob.V1
open Protocol
module Execution_error = struct
exception E of string
let raise string = raise (E string)
let raise_on_fs_error = function
| Error message -> raise message
| Ok result -> result
;;
end
module Fs : sig
val read_directory : string -> (string list, string) result
val read_file : string -> (string, string) result
val write_file : string -> string -> (unit, string) result
end = struct
let catch_system_exceptions f ~name =
try Ok (f ()) with
| Unix.Unix_error (error, syscall, arg) ->
let error = Unix_error.Detailed.create error ~syscall ~arg in
Error (name ^ ": " ^ Unix_error.Detailed.to_string_hum error)
| Sys_error error -> Error (name ^ ": " ^ error)
;;
let read_directory =
let rec loop dh acc =
match Unix.readdir dh with
| "." | ".." -> loop dh acc
| s -> loop dh (s :: acc)
| exception End_of_file -> acc
in
fun path ->
catch_system_exceptions ~name:"read_directory" (fun () ->
let dh = Unix.opendir path in
Exn.protect
~f:(fun () -> loop dh [] |> List.sort ~compare:String.compare)
~finally:(fun () -> Unix.closedir dh))
;;
let read_file path =
catch_system_exceptions ~name:"read_file" (fun () -> Io.String_path.read_file path)
;;
let write_file path data =
catch_system_exceptions ~name:"write_file" (fun () ->
Io.String_path.write_file path data)
;;
end
module Stage = struct
type 'a t =
{ action : unit -> 'a
; dependencies : Dependency.Set.t
; targets : String.Set.t
}
let map (t : 'a t) ~f = { t with action = (fun () -> f (t.action ())) }
let both (t1 : 'a t) (t2 : 'b t) =
{ action = (fun () -> t1.action (), t2.action ())
; dependencies = Dependency.Set.union t1.dependencies t2.dependencies
; targets = String.Set.union t1.targets t2.targets
}
;;
end
(* Construction inspired by free monad. *)
type 'a t =
| Pure of 'a
| Stage of 'a t Stage.t
let lift_stage stage = Stage (Stage.map stage ~f:(fun a -> Pure a))
let rec map (t : 'a t) ~f =
match t with
| Pure a -> Pure (f a)
| Stage at -> Stage (Stage.map ~f:(map ~f) at)
;;
let rec stage (t : 'a t) ~f =
match t with
| Pure a -> f a
| Stage at -> Stage (Stage.map ~f:(stage ~f) at)
;;
let return a = Pure a
let rec both (t1 : 'a t) (t2 : 'b t) =
match t1, t2 with
| Pure a1, _ -> map ~f:(fun a2 -> a1, a2) t2
| _, Pure a2 -> map ~f:(fun a1 -> a1, a2) t1
| Stage at1, Stage at2 ->
Stage (Stage.both at1 at2 |> Stage.map ~f:(fun (am1, am2) -> both am1 am2))
;;
let read_file ~path =
let path = Path.to_string path in
let action () = Fs.read_file path |> Execution_error.raise_on_fs_error in
lift_stage
{ action
; dependencies = Dependency.Set.singleton (File path)
; targets = String.Set.empty
}
;;
let write_file ~path ~data =
let path = Path.to_string path in
let action () = Fs.write_file path data |> Execution_error.raise_on_fs_error in
lift_stage
{ action; dependencies = Dependency.Set.empty; targets = String.Set.singleton path }
;;
(* TODO jstaron: If program tries to read empty directory, dune does not copy
it to `_build` so we get a "No such file or directory" error. *)
let read_directory_with_glob ~path ~glob =
let path = Path.to_string path in
let action () =
Fs.read_directory path
|> Execution_error.raise_on_fs_error
|> List.filter ~f:(Glob.test glob)
in
lift_stage
{ action
; dependencies =
Dependency.Set.singleton (Glob { path; glob = Glob.to_string glob })
; targets = String.Set.empty
}
;;
let rec run_by_dune t context =
match t with
| Pure () -> Context.respond context Done
| Stage at ->
let allowed_targets = Context.targets context in
let disallowed_targets = String.Set.diff at.targets allowed_targets in
(match String.Set.to_list disallowed_targets with
| [] -> ()
| [ t ] ->
Execution_error.raise
(Printf.sprintf
"%s is written despite not being declared as a target in dune file. To \
fix, add it to target list in dune file."
t)
| ts ->
Execution_error.raise
(Printf.sprintf
"Following files were written despite not being declared as targets in \
dune file:\n\
%sTo fix, add them to target list in dune file."
(ts |> String.concat ~sep:"\n")));
let prepared_dependencies = Context.prepared_dependencies context in
let required_dependencies =
Dependency.Set.diff at.dependencies prepared_dependencies
in
if Dependency.Set.is_empty required_dependencies
then run_by_dune (at.action ()) context
else Context.respond context (Need_more_deps required_dependencies)
;;
(* If executable is not run by dune, assume that all dependencies are already
prepared and no target checking is done. *)
let rec run_outside_of_dune t =
match t with
| Pure () -> ()
| Stage at -> run_outside_of_dune (at.action ())
;;
let do_run t =
match Protocol.Context.create () with
| Run_outside_of_dune -> run_outside_of_dune t
| Error message ->
Execution_error.raise
(Printf.sprintf
"Error during communication with dune. %s Did you use different dune version \
to compile the executable?"
message)
| Ok context -> run_by_dune t context
;;
let run t =
try
do_run t;
exit 0
with
| Execution_error.E message ->
prerr_endline message;
exit 1
;;
module O = struct
let ( let+ ) at f = map at ~f
let ( and+ ) = both
end
module Private = struct
module Protocol = Protocol
let do_run = do_run
module Execution_error = Execution_error
end
end
module Private = V1.Private

View file

@ -0,0 +1,122 @@
[@@@alert unstable "The API of this library is not stable and may change without notice."]
[@@@alert "-unstable"]
module V1 : sig
(** Applicative and monadic interface for declaring dependencies.
This module is intended to be used as an interface for declaring
dependencies of a computation. Dependencies can be declared dynamically -
the list of dependencies can depend on previous dependencies.
Note: Monadic "bind" is provided, but it can be very costly. It's called
[stage] to discourage people from overusing it. When dune decides that the
action needs to be re-run, it runs (nontrivial) stages one by one, and
starts a process from scratch for every stage. So a linear chain of binds
leads to a linear number of program re-runs, and therefore overall
quadratic time complexity. This also means that using non-deterministic
mutable state can lead to surprising results. (note that with the current
implementation, nontrivial stages are those that have some dependencies,
so a stage that merely writes out some targets is "free") *)
module Path = Path
type 'a t
(** {1:monadic_interface Applicative/monadic interface} *)
(** [return a] creates a pure computation resulting in [a]. *)
val return : 'a -> 'a t
(** If [at] is a computation resulting in [a] then [map at ~f] is a
computation resulting in [f a]. *)
val map : 'a t -> f:('a -> 'b) -> 'b t
(** If [at] is a computation resulting in [a] and [bt] is computation
resulting in [b] then [both at bt] is a computation resulting in [(a, b)]. *)
val both : 'a t -> 'b t -> ('a * 'b) t
(** If [at] is a computation resulting in value of type ['a] and [f] is a
function taking value of type ['a] and returning a computation [bt] then
[stage a ~f] is a computation that is equivalent to staging computation
[bt] after computation [at].
Note: This is a monadic "bind" function. This function is costly so
different name was chosen to discourage excessive use. *)
val stage : 'a t -> f:('a -> 'b t) -> 'b t
(** {1 Syntax sugar for applicative subset} *)
(** Syntax sugar for applicative subset of the interface. Syntax sugar for
[stage] is not provided to prevent accidental use.*)
module O : sig
(** {[
let+ a = g in
h
]}
is equivalent to:
{[
map g ~f:(fun a -> h)
]} *)
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
(** {[
let+ a1 = g1
and+ a2 = g2 in
h
]}
is equivalent to:
{[
both g1 g2 |> map ~f:(fun (a1, a2) -> h)
]} *)
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
end
(** {1:interaction Declaring dependencies and interacting with filesystem} *)
(** [read_file ~path:file] returns a computation depending on a [file] to be
run and resulting in a file content. *)
val read_file : path:Path.t -> string t
(** [write_file ~path:file ~data] returns a computation that writes [data] to
a [file].
Note: [file] must be declared as a target in dune build file. *)
val write_file : path:Path.t -> data:string -> unit t
(** [read_directory_with_glob ~path:directory ~glob] returns a computation
depending on a listing of a [directory] (including source and target
files) filtered by glob and resulting in that listing.
It's better to specify as narrow filtering by [glob] as possible (as
opposed to filtering afterwards) because this makes dune aware of the
filtering, so dune won't re-run the action when the directory changes in
an unimportant way.
BUG: [read_directory_with_glob] doesn't work correctly for empty
directories.
BUG: the returned listing includes directories even though that dependency
is not tracked. *)
val read_directory_with_glob : path:Path.t -> glob:Dune_glob.V1.t -> string list t
(** {1:running Running the computation} *)
(** Runs the computation. This function never returns. *)
val run : unit t -> 'a
end
(* [Private] module should only be used by dune itself. Its stability will not
be maintained by the future library releases. *)
module Private : sig
module Protocol = Protocol
val do_run : unit V1.t -> unit
module Execution_error : sig
exception E of string
end
end

View file

@ -0,0 +1,16 @@
include struct
open Stdune
module Unix_error = Unix_error
module List = List
module Set = Set
module Exn = Exn
module String = String
module Io = Io
module Sexp = Sexp
module Option = Option
module Comparable = Comparable
module Result = Result
module Map = Map
end
module Conv = Dune_rpc_private.Conv

View file

@ -0,0 +1,19 @@
type t = string
let concat = Filename.concat
let to_string t = t
let of_string path =
match Filename.is_relative path with
| false ->
invalid_arg
(Printf.sprintf
"Path \"%s\" is absolute. All paths used with dune-action-plugin must be \
relative."
path)
| true -> path
;;
module O = struct
let ( ^/ ) = concat
end

View file

@ -0,0 +1,20 @@
(** Representation of paths for "dune_action_plugin" library. *)
(** We shouldn't use absolute paths when communicating with Dune, so this module
allows user to represent only relative paths. *)
type t
module O : sig
(** Concatenate two paths. *)
val ( ^/ ) : t -> t -> t
end
(** Concatenate two paths. *)
val concat : t -> t -> t
val to_string : t -> string
(** Convert path to string. Throws an Invalid_argument exception if passed
string is not a relative path. *)
val of_string : string -> t

View file

@ -0,0 +1,194 @@
open Import
let run_by_dune_env_variable = "DUNE_DYNAMIC_RUN_CLIENT"
module Error = Sexpable_intf.Error
module Dependency = struct
module T = struct
type t =
| File of string
| Directory of string
| Glob of
{ path : string
; glob : string
}
let conv =
let open Conv in
let file = constr "File" string (fun s -> File s) in
let directory = constr "Directory" string (fun s -> Directory s) in
let glob_cstr =
constr "Glob" (pair string string) (fun (path, glob) -> Glob { path; glob })
in
sum
[ econstr file; econstr directory; econstr glob_cstr ]
(function
| File s -> case s file
| Directory s -> case s directory
| Glob { path; glob } -> case (path, glob) glob_cstr)
;;
let compare x y =
match x, y with
| File x, File y -> String.compare x y
| File _, _ -> Lt
| _, File _ -> Gt
| Directory x, Directory y -> String.compare x y
| Directory _, _ -> Lt
| _, Directory _ -> Gt
| Glob { path; glob }, Glob t ->
let open Ordering.O in
let= () = String.compare path t.path in
String.compare glob t.glob
;;
let to_dyn = Dyn.opaque
end
include T
module O = Comparable.Make (T)
module Map = O.Map
module Set = struct
include O.Set
let conv : t Conv.value = Conv.iso (Conv.list conv) of_list to_list
end
end
module Greeting = struct
module T = struct
type t =
{ run_arguments_fn : string
; response_fn : string
}
let conv =
let open Conv in
let to_ (run_arguments_fn, response_fn) = { run_arguments_fn; response_fn } in
let from { run_arguments_fn; response_fn } = run_arguments_fn, response_fn in
iso (pair string string) to_ from
;;
let version = 0
end
include T
include Sexpable_intf.Make (T)
end
module Run_arguments = struct
module T = struct
type t =
{ prepared_dependencies : Dependency.Set.t
; targets : String.Set.t
}
let conv =
let from { prepared_dependencies; targets } = prepared_dependencies, targets in
let to_ (prepared_dependencies, targets) = { prepared_dependencies; targets } in
let string_set =
Conv.iso Conv.(list string) String.Set.of_list String.Set.to_list
in
let conv = Conv.pair Dependency.Set.conv string_set in
Conv.iso conv to_ from
;;
let version = 0
end
include T
include Sexpable_intf.Make (T)
end
module Response = struct
module T = struct
type t =
| Done
| Need_more_deps of Dependency.Set.t
let conv =
let open Conv in
let done_ = constr "Done" unit (fun () -> Done) in
let need_more_deps =
constr "Need_more_deps" Dependency.Set.conv (fun deps -> Need_more_deps deps)
in
sum
[ econstr done_; econstr need_more_deps ]
(function
| Done -> case () done_
| Need_more_deps deps -> case deps need_more_deps)
;;
let version = 0
end
include T
include Sexpable_intf.Make (T)
end
module Context = struct
type t =
{ response_fn : string
; prepared_dependencies : Dependency.Set.t
; targets : String.Set.t
}
type create_result =
| Ok of t
| Run_outside_of_dune
| Error of string
let cannot_parse_error = Error "Can not parse dune message."
let version_mismatch_error =
Error
"Dune version is incompatible with dune-action-plugin library version that was \
used to build this executable."
;;
let cannot_read_file = Error "Cannot read file containing dune message."
let file_not_found_error = Error "Cannot find file containing dune message."
let create () =
match Sys.getenv_opt run_by_dune_env_variable with
| None -> Run_outside_of_dune
| Some value ->
(match Csexp.parse_string value with
| Error _ -> cannot_parse_error
| Ok sexp ->
(match Greeting.of_sexp sexp with
| Error (Version_mismatch _) -> version_mismatch_error
| Error Parse_error -> cannot_parse_error
| Ok greeting ->
(match
( Result.try_with (fun () ->
Io.String_path.read_file greeting.run_arguments_fn)
, Sys.file_exists greeting.response_fn )
with
| _, false -> file_not_found_error
| Error _, _ -> cannot_read_file
| Ok data, true ->
(match Csexp.parse_string data with
| Error _ -> cannot_parse_error
| Ok sexp ->
(match Run_arguments.of_sexp sexp with
| Error (Version_mismatch _) -> version_mismatch_error
| Error Parse_error -> cannot_parse_error
| Ok { prepared_dependencies; targets } ->
Ok
{ response_fn = greeting.response_fn
; prepared_dependencies
; targets
})))))
;;
let prepared_dependencies (t : t) = t.prepared_dependencies
let targets (t : t) = t.targets
let respond (t : t) response =
let data = Response.to_sexp response |> Csexp.to_string in
Io.String_path.write_file t.response_fn data
;;
end

View file

@ -0,0 +1,62 @@
open Import
open Sexpable_intf
module Error : module type of Error
module Dependency : sig
type t =
| File of string
| Directory of string
| Glob of
{ path : string
; glob : string
}
module Map : Map.S with type key = t
module Set : sig
include Set.S with type elt = t and type 'a map = 'a Map.t
end
end
module Greeting : sig
type t =
{ run_arguments_fn : string
; response_fn : string
}
include Sexpable with type t := t
end
module Run_arguments : sig
type t =
{ prepared_dependencies : Dependency.Set.t
; targets : String.Set.t
}
include Sexpable with type t := t
end
module Response : sig
type t =
| Done
| Need_more_deps of Dependency.Set.t
include Sexpable with type t := t
end
(** Dune sets this environment variable to pass [Greeting.t] to client. *)
val run_by_dune_env_variable : string
module Context : sig
type t
type create_result =
| Ok of t
| Run_outside_of_dune
| Error of string
val create : unit -> create_result
val prepared_dependencies : t -> Dependency.Set.t
val targets : t -> String.Set.t
val respond : t -> Response.t -> unit
end

View file

@ -0,0 +1,42 @@
open Import
module Error = struct
type t =
| Version_mismatch of int
| Parse_error
end
module type Sexpable = sig
type t
val to_sexp : t -> Sexp.t
val of_sexp : Sexp.t -> (t, Error.t) result
end
module type S = sig
type t
val conv : t Conv.value
val version : int
end
module Make (Type : S) = struct
let conv =
let open Conv in
pair int Type.conv
;;
let of_sexp sexp : (_, Error.t) result =
match Conv.of_sexp Conv.(pair int sexp) ~version:(0, 0) sexp with
| Error _ -> Error Parse_error
| Ok (version, sexp) ->
(match Int.equal version Type.version with
| false -> Error (Version_mismatch version)
| true ->
(match Conv.of_sexp Type.conv ~version:(0, 0) sexp with
| Error _ -> Error Parse_error
| Ok v -> Ok v))
;;
let to_sexp t = Conv.to_sexp conv (Type.version, t)
end

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin dune-glob))

View file

@ -0,0 +1,12 @@
open Dune_action_plugin.V1
module Glob = Dune_glob.V1
let action =
let open Dune_action_plugin.V1.O in
let+ listing =
read_directory_with_glob ~glob:Glob.universal ~path:(Path.of_string "some_dir")
in
String.concat "; " listing |> Printf.printf "Directory listing: [%s]"
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,21 @@
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (data_only_dirs some_dir)
> \
> (rule
> (alias runtest)
> (action (dynamic-run ./foo.exe)))
> EOF
$ mkdir some_dir
$ touch some_dir/some_file1
$ touch some_dir/some_file2
$ cp ./bin/foo.exe ./
$ dune runtest
Directory listing: [some_file1; some_file2]

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin))

View file

@ -0,0 +1,9 @@
open Dune_action_plugin.V1
let action =
let open Dune_action_plugin.V1.O in
let+ data = read_file ~path:(Path.of_string "some_file") in
print_endline data
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,31 @@
This test checks that 'dynamic-run' will not be reexecuted if
dependencies do not change (have the same digest) even if
they were forced to rebuild.
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (target some_file)
> (deps (universe))
> (action
> (progn
> (echo "Building some_file!\n")
> (with-stdout-to %{target} (echo "Hello from some_file!")))))
> \
> (rule
> (alias runtest)
> (action (dynamic-run ./foo.exe)))
> EOF
$ cp ./bin/foo.exe ./
$ dune runtest
Building some_file!
Hello from some_file!
$ dune runtest
Building some_file!

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune_action_plugin dune_glob))

View file

@ -0,0 +1,11 @@
open Dune_action_plugin.V1
module Glob = Dune_glob.V1
let action =
let open Dune_action_plugin.V1.O in
let glob = Glob.of_string "some_file*" in
let+ listing = read_directory_with_glob ~path:(Path.of_string "some_dir") ~glob in
String.concat "\n" listing |> print_endline
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,43 @@
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (alias runtest)
> (action (dynamic-run ./foo.exe)))
> EOF
$ mkdir some_dir
$ cat > some_dir/dune << EOF
> (rule
> (target some_file)
> (action
> (progn
> (echo "Building some_file!\n")
> (with-stdout-to %{target} (echo "")))))
> \
> (rule
> (target another_file)
> (action
> (progn
> (echo "SHOULD NOT BE PRINTED!")
> (with-stdout-to %{target} (echo "")))))
> \
> (rule
> (target some_file_but_different)
> (action
> (progn
> (echo "Building some_file_but_different!\n")
> (with-stdout-to %{target} (echo "")))))
> EOF
$ cp ./bin/foo.exe ./
$ dune runtest
Building some_file!
Building some_file_but_different!
some_file
some_file_but_different

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin dune-glob))

View file

@ -0,0 +1,11 @@
open Dune_action_plugin.V1
module Glob = Dune_glob.V1
let action =
let open Dune_action_plugin.V1.O in
let+ _ = read_directory_with_glob ~glob:Glob.universal ~path:(Path.of_string ".")
and+ _ = write_file ~path:(Path.of_string "some_file") ~data:"Hello from some_file!" in
()
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,22 @@
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (target some_file)
> (action
> (dynamic-run ./foo.exe)))
> EOF
$ cp ./bin/foo.exe ./
$ dune build some_file 2>&1 | awk '/Internal error/,/unable to serialize/'
Internal error, please report upstream including the contents of _build/log.
Description:
("unable to serialize exception",
^ This is not great. There is no actual dependency cycle, dune is just
interpreting glob dependency too coarsely (it builds all files instead
of just bringing the directory listing up to date).

View file

@ -0,0 +1,3 @@
(executables
(names foo1 foo2)
(libraries dune-action-plugin))

View file

@ -0,0 +1,5 @@
open Dune_action_plugin.V1
let path = Path.of_string "some_file1"
let action = read_file ~path |> stage ~f:(fun data -> write_file ~path ~data)
let () = run action

View file

@ -0,0 +1,13 @@
open Dune_action_plugin.V1
let path = Path.of_string "some_file2"
let action =
let open Dune_action_plugin.V1.O in
write_file ~path ~data:"Hello from some_file2!"
|> stage ~f:(fun () ->
let+ data = read_file ~path in
print_endline data)
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,29 @@
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (target some_file1)
> (action
> (dynamic-run ./foo1.exe)))
> \
> (rule
> (target some_file2)
> (action
> (dynamic-run ./foo2.exe)))
> EOF
$ cp ./bin/foo1.exe ./
$ cp ./bin/foo2.exe ./
$ dune build some_file1
Error: Dependency cycle between:
_build/default/some_file1
[1]
$ dune build some_file2
Error: Dependency cycle between:
_build/default/some_file2
[1]

View file

@ -0,0 +1,11 @@
open Dune_action_plugin.V1
let action =
let open Dune_action_plugin.V1.O in
let switch = read_file ~path:(Path.of_string "foo_or_bar") in
stage switch ~f:(fun file ->
let+ data = read_file ~path:(Path.of_string file) in
print_endline data)
;;
let () = run action

View file

@ -0,0 +1,3 @@
(executables
(names client)
(libraries dune-action-plugin))

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,57 @@
This test checks that in case the dependency of multi staged computation changes,
only the dependencies up to this stage are rebuilt.
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (deps bar_source)
> (target bar)
> (action
> (progn
> (echo "Building bar!\n")
> (copy %{deps} %{target}))))
> \
> (rule
> (deps foo_source)
> (target foo)
> (action
> (progn
> (echo "Building foo!\n")
> (copy %{deps} %{target}))))
> \
> (rule
> (deps foo_or_bar_source)
> (target foo_or_bar)
> (action
> (progn
> (echo "Building foo_or_bar!\n")
> (copy %{deps} %{target}))))
> \
> (rule
> (alias runtest)
> (action (dynamic-run ./client.exe)))
> EOF
$ cp ./bin/client.exe ./
$ printf "foo" > foo_or_bar_source
$ printf "Hello from foo!" > foo_source
$ printf "SHOULD NOT BE PRINTED!" > bar_source
$ dune runtest
Building foo_or_bar!
Building foo!
Hello from foo!
$ printf "bar" > foo_or_bar_source
$ printf "SHOULD NOT BE PRINTED!" > foo_source
$ printf "Hello from bar!" > bar_source
$ dune runtest
Building foo_or_bar!
Building bar!
Hello from bar!

View file

@ -0,0 +1,5 @@
(cram
(applies_to :whole_subtree)
(alias run_dynamic)
(deps
(package dune)))

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin))

View file

@ -0,0 +1,3 @@
open Dune_action_plugin.V1
let () = run (return ())

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,32 @@
Check that multiple 'dynamic-run' commands within single action are
detected and error is printed even if the rule is not executed.
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (target some_file)
> (action
> (progn
> (dynamic-run ./foo.exe some_arg)
> (dynamic-run ./foo.exe another_arg))))
> \
> (alias
> (name runtest)
> (action
> (echo "SHOULD NOT BE PRINTED")))
> EOF
$ cp ../bin/foo.exe ./
$ dune runtest
File "dune", lines 4-6, characters 2-84:
4 | (progn
5 | (dynamic-run ./foo.exe some_arg)
6 | (dynamic-run ./foo.exe another_arg))))
Error: Multiple 'dynamic-run' commands within single action are not
supported.
[1]

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune_action_plugin))

View file

@ -0,0 +1,3 @@
open Dune_action_plugin.V1
let () = run (return (print_endline "Hello from foo!"))

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,19 @@
This test checks that executable that uses 'dynamic-run'
but requires no dependencies can be successfully run.
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (alias runtest)
> (action (dynamic-run ./foo.exe)))
> EOF
$ cp ./bin/foo.exe ./
$ dune runtest
Hello from foo!

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin))

View file

@ -0,0 +1,9 @@
open Dune_action_plugin.V1
let action =
let open Dune_action_plugin.V1.O in
let+ data = read_file ~path:(Path.of_string "some_absent_dependency") in
print_endline data
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,20 @@
This test checks that executable that uses 'dynamic-run'
and requires dependency that can not be build fails.
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (alias runtest)
> (action (dynamic-run ./foo.exe)))
> EOF
$ cp ./bin/foo.exe ./
$ dune runtest 2>&1 | awk '/Internal error/,/unable to serialize/'
Internal error, please report upstream including the contents of _build/log.
Description:
("unable to serialize exception",

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin))

View file

@ -0,0 +1,9 @@
open Dune_action_plugin.V1
let action =
let open Dune_action_plugin.V1.O in
let+ data = read_file ~path:(Path.of_string "some_dependency") in
print_endline data
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,28 @@
This test checks that 'dynamic-run' can work
when we 'chdir' into different directory.
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (alias runtest)
> (action
> (chdir some_dir
> (dynamic-run ./foo.exe))))
> EOF
$ mkdir some_dir
$ cat > some_dir/dune << EOF
> (rule
> (target some_dependency)
> (action
> (with-stdout-to %{target} (echo "Hello from some_dependency!"))))
> EOF
$ cp ./bin/foo.exe ./some_dir
$ dune runtest
Hello from some_dependency!

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin))

View file

@ -0,0 +1,9 @@
open Dune_action_plugin.V1
let action =
let open Dune_action_plugin.V1.O in
let+ data = read_file ~path:(Path.of_string "some_dependency") in
print_endline data
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,22 @@
This test checks that executable that uses 'dynamic-run'
and requires one dependency can be successfully run.
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (target some_dependency)
> (action (with-stdout-to %{target} (echo "Hello from some_dependency!"))))
> \
> (rule
> (alias runtest)
> (action (dynamic-run ./foo.exe)))
> EOF
$ cp ./bin/foo.exe ./
$ dune runtest
Hello from some_dependency!

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin dune-glob))

View file

@ -0,0 +1,12 @@
open Dune_action_plugin.V1
module Glob = Dune_glob.V1
let action =
let open Dune_action_plugin.V1.O in
let+ listing =
read_directory_with_glob ~glob:Glob.universal ~path:(Path.of_string "some_dir")
in
String.concat "\n" listing |> print_endline
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,38 @@
This test checks that executable that uses 'dynamic-run'
and depends on directory listing forces all targets in that
directory to be build.
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (alias runtest)
> (action (dynamic-run ./foo.exe)))
> EOF
$ mkdir some_dir
$ cat > some_dir/dune << EOF
> (rule
> (target some_file1)
> (action (with-stdout-to %{target} (echo ""))))
> \
> (rule
> (target some_file2)
> (action (with-stdout-to %{target} (echo ""))))
> \
> (rule
> (target some_file3)
> (action (with-stdout-to %{target} (echo ""))))
> EOF
$ cp ./bin/foo.exe ./
$ dune runtest
dune
some_file1
some_file2
some_file3

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin))

View file

@ -0,0 +1,7 @@
open Dune_action_plugin.V1
let action =
write_file ~path:(Path.of_string "some_target") ~data:"Hello from some_target!"
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,20 @@
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (target some_target)
> (action
> (dynamic-run ./foo.exe)))
> \
> (rule
> (alias runtest)
> (action (cat some_target)))
> EOF
$ cp ./bin/foo.exe ./
$ dune runtest
Hello from some_target!

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin))

View file

@ -0,0 +1,4 @@
open Dune_action_plugin.V1
let action = write_file ~path:(Path.of_string "bar") ~data:"Hello from bar!"
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,20 @@
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (alias runtest)
> (action (dynamic-run ./foo.exe)))
> EOF
$ cp ./bin/foo.exe ./
$ dune runtest
File "dune", lines 1-3, characters 0-57:
1 | (rule
2 | (alias runtest)
3 | (action (dynamic-run ./foo.exe)))
bar is written despite not being declared as a target in dune file. To fix, add it to target list in dune file.
[1]

View file

@ -0,0 +1,2 @@
(executables
(names foo))

View file

@ -0,0 +1 @@
let () = print_endline "Hello from foo!"

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,29 @@
This test checks that dune can gracefully handle situation when user provides
ordinary executable instead of one linked against dune-action-plugin.
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (alias runtest)
> (action (dynamic-run ./foo.exe)))
> EOF
$ cp ./bin/foo.exe ./
$ dune runtest
Hello from foo!
File "dune", lines 1-3, characters 0-57:
1 | (rule
2 | (alias runtest)
3 | (action (dynamic-run ./foo.exe)))
Error: Executable 'foo.exe' declared as using dune-action-plugin (declared
with 'dynamic-run' tag) failed to respond to dune.
If you don't use dynamic dependency discovery in your executable you may
consider changing 'dynamic-run' to 'run' in your rule definition.
[1]

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin))

View file

@ -0,0 +1,8 @@
open Dune_action_plugin.V1
let action =
read_file ~path:(Path.of_string "some_source")
|> stage ~f:(fun data -> write_file ~path:(Path.of_string "some_copy") ~data)
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,28 @@
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (target some_source)
> (action (with-stdout-to %{target} (echo "Hello there!\n"))))
> \
> (rule
> (target some_copy)
> (action
> (dynamic-run ./foo.exe)))
> \
> (rule
> (alias runtest)
> (action
> (progn
> (cat some_source)
> (cat some_copy))))
> EOF
$ cp ./bin/foo.exe ./
$ dune runtest
Hello there!
Hello there!

View file

@ -0,0 +1,3 @@
(executables
(names foo)
(libraries dune-action-plugin))

View file

@ -0,0 +1,7 @@
open Dune_action_plugin.V1
let action =
write_file ~path:(Path.of_string "../some_file") ~data:"Hello from some_file!"
;;
let () = run action

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,23 @@
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (target some_file)
> (action
> (chdir some_dir
> (dynamic-run ./foo.exe))))
> \
> (rule
> (alias runtest)
> (action (cat some_file)))
> EOF
$ mkdir some_dir
$ cp ./bin/foo.exe ./some_dir/
$ dune runtest
Hello from some_file!

View file

@ -0,0 +1,11 @@
open Dune_action_plugin.V1
let action =
let open Dune_action_plugin.V1.O in
let switch = read_file ~path:(Path.of_string "foo_or_bar") in
stage switch ~f:(fun file ->
let+ data = read_file ~path:(Path.of_string file) in
print_endline data)
;;
let () = run action

View file

@ -0,0 +1,3 @@
(executables
(names client)
(libraries dune-action-plugin))

View file

@ -0,0 +1,3 @@
(cram
(deps
(glob_files bin/*.exe)))

View file

@ -0,0 +1,37 @@
In this test client choose what to depend
on based on dependency from the previous stage.
$ cat > dune-project << EOF
> (lang dune 2.0)
> (using action-plugin 0.1)
> EOF
$ cat > dune << EOF
> (rule
> (target bar)
> (action
> (progn
> (echo "Building bar!\n")
> (with-stdout-to %{target} (echo "Hello from bar!")))))
> \
> (rule
> (target foo)
> (action
> (progn
> (echo "SHOULD NOT BE PRINTED!\n")
> (with-stdout-to %{target} (echo "Hello from foo!")))))
> \
> (rule
> (target foo_or_bar)
> (action (with-stdout-to %{target} (echo "bar"))))
> \
> (rule
> (alias runtest)
> (action (dynamic-run ./client.exe)))
> EOF
$ cp ./bin/client.exe ./
$ dune runtest
Building bar!
Hello from bar!