From cecf0a2aaf34411a67e3960f6a0554f0b2f2237e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Wed, 17 May 2017 09:33:09 +0200 Subject: [PATCH] Add (copy_files ) stanza (#35) Add (copy_files ) and (copy_files# ) stanzas. These stanzas setup rules for copying files from a sub-directory to the current directory. This provides a reasonable way to support multi-directory library/executables in jbuilder. --- doc/jbuild.rst | 16 ++++ src/action.ml | 2 + src/build.ml | 5 ++ src/build.mli | 1 + src/gen_rules.ml | 85 ++++++++++++++++--- src/jbuild.ml | 13 +++ src/jbuild.mli | 8 ++ src/merlin.ml | 15 +++- src/merlin.mli | 1 + src/path.mli | 1 + test/blackbox-tests/jbuild | 7 ++ .../test-cases/copy_files/jbuild | 6 ++ .../test-cases/copy_files/lexers/jbuild | 3 + .../test-cases/copy_files/lexers/lexer1.mll | 6 ++ .../test-cases/copy_files/run.t | 8 ++ .../test-cases/copy_files/test.ml | 1 + 16 files changed, 163 insertions(+), 15 deletions(-) create mode 100644 test/blackbox-tests/test-cases/copy_files/jbuild create mode 100644 test/blackbox-tests/test-cases/copy_files/lexers/jbuild create mode 100644 test/blackbox-tests/test-cases/copy_files/lexers/lexer1.mll create mode 100644 test/blackbox-tests/test-cases/copy_files/run.t create mode 100644 test/blackbox-tests/test-cases/copy_files/test.ml diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 23abe375..66547fa7 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -511,6 +511,22 @@ stanza, if the source file has extension ``.exe`` or ``.bc``, then Jbuilder implicitly adds the ``.exe`` extension to the destination, if not already present. +copy_files +---------- + +The ``copy_files`` and ``copy_files#`` stanzas allow to specify that +files from another directory could be copied if needed to the current +directory. + +The syntax is as follows: + +.. code:: scheme + + (copy_files ) + +```` represents the set of files to copy, see the :ref:`glob +` for details. + Common items ============ diff --git a/src/action.ml b/src/action.ml index 6fc9cbf2..c7b8f342 100644 --- a/src/action.ml +++ b/src/action.ml @@ -54,6 +54,8 @@ struct ; cstr_loc "copy-and-add-line-directive" (path @> path @> nil) (fun loc src dst -> Loc.warn loc "copy-and-add-line-directive is deprecated, use copy# instead"; Copy_and_add_line_directive (src, dst)) + ; cstr "copy#" (path @> path @> nil) (fun src dst -> + Copy_and_add_line_directive (src, dst)) ; cstr "system" (string @> nil) (fun cmd -> System cmd) ; cstr "bash" (string @> nil) (fun cmd -> Bash cmd) ; cstr "write-file" (path @> string @> nil) (fun fn s -> Write_file (fn, s)) diff --git a/src/build.ml b/src/build.ml index 3fb187ad..3776b38f 100644 --- a/src/build.ml +++ b/src/build.ml @@ -255,6 +255,11 @@ let copy ~src ~dst = path src >>> action ~targets:[dst] (Copy (src, dst)) +let copy_and_add_line_directive ~src ~dst = + path src >>> + action ~targets:[dst] + (Copy_and_add_line_directive (src, dst)) + let symlink ~src ~dst = path src >>> action ~targets:[dst] (Symlink (src, dst)) diff --git a/src/build.mli b/src/build.mli index e7c6dfcf..13211195 100644 --- a/src/build.mli +++ b/src/build.mli @@ -108,6 +108,7 @@ val write_file : Path.t -> string -> (unit, Action.t) t val write_file_dyn : Path.t -> (string, Action.t) t val copy : src:Path.t -> dst:Path.t -> (unit, Action.t) t +val copy_and_add_line_directive : src:Path.t -> dst:Path.t -> (unit, Action.t) t val symlink : src:Path.t -> dst:Path.t -> (unit, Action.t) t diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 022a63ea..6466475f 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -421,6 +421,7 @@ module Gen(P : Params) = struct ; flags ; preprocess = Buildable.single_preprocess lib.buildable ; libname = Some lib.name + ; source_dirs = Path.Set.empty } (* +-----------------------------------------------------------------+ @@ -539,6 +540,7 @@ module Gen(P : Params) = struct ; flags = Ocaml_flags.common flags ; preprocess = Buildable.single_preprocess exes.buildable ; libname = None + ; source_dirs = Path.Set.empty } (* +-----------------------------------------------------------------+ @@ -599,6 +601,51 @@ module Gen(P : Params) = struct ; Build.create_file digest_path ]) + let copy_files_rules (def: Copy_files.t) ~src_dir ~dir ~scope = + let loc = String_with_vars.loc def.glob in + let glob_in_src = + let src_glob = SC.expand_vars sctx ~dir def.glob ~scope in + Path.relative src_dir src_glob ~error_loc:loc + in + (* The following condition is required for merlin to work. + Additionally, the order in which the rules are evaluated only + ensures that [sources_and_targets_known_so_far] returns the + right answer for sub-directories only. *) + if not (Path.is_descendant glob_in_src ~of_:src_dir) then + Loc.fail loc "%s is not a sub-directory of %s" + (Path.to_string_maybe_quoted glob_in_src) (Path.to_string_maybe_quoted src_dir); + let glob = Path.basename glob_in_src in + let src_in_src = Path.parent glob_in_src in + let re = + match Glob_lexer.parse_string glob with + | Ok re -> + Re.compile re + | Error (_pos, msg) -> + Loc.fail (String_with_vars.loc def.glob) "invalid glob: %s" msg + in + (* add rules *) + let files = SC.sources_and_targets_known_so_far sctx ~src_path:src_in_src in + let src_in_build = Path.append ctx.build_dir src_in_src in + String_set.iter files ~f:(fun basename -> + let matches = Re.execp re basename in + if matches then + let file_src = Path.relative src_in_build basename in + let file_dst = Path.relative dir basename in + SC.add_rule sctx + ((if def.add_line_directive + then Build.copy_and_add_line_directive + else Build.copy) + ~src:file_src + ~dst:file_dst) + ); + { Merlin.requires = Build.return [] + ; flags = Build.return [] + ; preprocess = Jbuild.Preprocess.No_preprocessing + ; libname = None + ; source_dirs = Path.Set.singleton src_in_src + } + + (* +-----------------------------------------------------------------+ | Modules listing | +-----------------------------------------------------------------+ *) @@ -704,12 +751,16 @@ Add it to your jbuild file to remove this warning. let rules { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope } = (* Interpret user rules and other simple stanzas first in order to populate the known target table, which is needed for guessing the list of modules. *) - List.iter stanzas ~f:(fun stanza -> - let dir = ctx_dir in - match (stanza : Stanza.t) with - | Rule rule -> user_rule rule ~dir ~scope - | Alias alias -> alias_rules alias ~dir ~scope - | Library _ | Executables _ | Provides _ | Install _ -> ()); + let merlins = + List.filter_map stanzas ~f:(fun stanza -> + let dir = ctx_dir in + match (stanza : Stanza.t) with + | Rule rule -> user_rule rule ~dir ~scope; None + | Alias alias -> alias_rules alias ~dir ~scope; None + | Copy_files def -> + Some (copy_files_rules def ~src_dir ~dir ~scope) + | Library _ | Executables _ | Provides _ | Install _ -> None) + in let files = lazy ( let files = SC.sources_and_targets_known_so_far sctx ~src_path:src_dir in (* Manually add files generated by the (select ...) dependencies since we haven't @@ -727,15 +778,17 @@ Add it to your jbuild file to remove this warning. guess_modules ~dir:src_dir ~files:(Lazy.force files)) in - List.filter_map stanzas ~f:(fun stanza -> + List.fold_left stanzas ~init:merlins ~f:(fun merlins stanza -> let dir = ctx_dir in match (stanza : Stanza.t) with | Library lib -> - Some (library_rules lib ~dir ~all_modules:(Lazy.force all_modules) - ~files:(Lazy.force files) ~scope) + library_rules lib ~dir ~all_modules:(Lazy.force all_modules) + ~files:(Lazy.force files) ~scope + :: merlins | Executables exes -> - Some (executables_rules exes ~dir ~all_modules:(Lazy.force all_modules) ~scope) - | _ -> None) + executables_rules exes ~dir ~all_modules:(Lazy.force all_modules) ~scope + :: merlins + | _ -> merlins) |> Merlin.merge_all |> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir); Option.iter (Utop.exe_stanzas stanzas) ~f:(fun (exe, all_modules) -> @@ -745,7 +798,15 @@ Add it to your jbuild file to remove this warning. Utop.add_module_rules sctx ~dir merlin.requires; ) - let () = List.iter (SC.stanzas sctx) ~f:rules + let () = + (* Sort the list of stanzas by directory so that we traverse + subdirectories first. + + This is required for correctly interpreting [copy_files]. *) + let subtree_smaller x y = + Path.compare y.SC.Dir_with_jbuild.src_dir x.SC.Dir_with_jbuild.src_dir in + let stanzas = List.sort ~cmp:subtree_smaller (SC.stanzas sctx) in + List.iter stanzas ~f:rules let () = SC.add_rules sctx (Js_of_ocaml_rules.setup_separate_compilation_rules sctx) let () = Odoc.setup_css_rule sctx diff --git a/src/jbuild.ml b/src/jbuild.ml index 74de14ce..d59d7afe 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -886,6 +886,14 @@ module Alias_conf = struct }) end +module Copy_files = struct + type t = { add_line_directive : bool + ; glob : String_with_vars.t + } + + let v1 = String_with_vars.t +end + module Stanza = struct type t = | Library of Library.t @@ -894,6 +902,7 @@ module Stanza = struct | Provides of Provides.t | Install of Install_conf.t | Alias of Alias_conf.t + | Copy_files of Copy_files.t let rules l = List.map l ~f:(fun x -> Rule x) @@ -913,6 +922,10 @@ module Stanza = struct ; cstr_loc "menhir" (Menhir.v1 @> nil) (fun loc x -> rules (Menhir.v1_to_rule loc x)) ; cstr "install" (Install_conf.v1 pkgs @> nil) (fun x -> [Install x]) ; cstr "alias" (Alias_conf.v1 pkgs @> nil) (fun x -> [Alias x]) + ; cstr "copy_files" (Copy_files.v1 @> nil) + (fun glob -> [Copy_files {add_line_directive = false; glob}]) + ; cstr "copy_files#" (Copy_files.v1 @> nil) + (fun glob -> [Copy_files {add_line_directive = true; glob}]) (* Just for validation and error messages *) ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> []) ] diff --git a/src/jbuild.mli b/src/jbuild.mli index 15e1828b..b74a9556 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -222,6 +222,13 @@ module Alias_conf : sig } end +module Copy_files : sig + type t = + { add_line_directive : bool + ; glob : String_with_vars.t + } +end + module Stanza : sig type t = | Library of Library.t @@ -230,6 +237,7 @@ module Stanza : sig | Provides of Provides.t | Install of Install_conf.t | Alias of Alias_conf.t + | Copy_files of Copy_files.t end module Stanzas : sig diff --git a/src/merlin.ml b/src/merlin.ml index 67e42da5..0978253d 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -9,6 +9,7 @@ type t = ; flags : (unit, string list) Build.t ; preprocess : Jbuild.Preprocess.t ; libname : string option + ; source_dirs: Path.Set.t } (* This must be forced after we change the cwd to the workspace root *) @@ -55,6 +56,12 @@ let dot_merlin sctx ~dir ({ requires; flags; _ } as t) = internals, ("PKG " ^ pkg.name) :: externals ) in + let source_dirs = + Path.Set.fold t.source_dirs ~init:[] ~f:(fun path acc -> + let path = Path.reach path ~from:remaindir in + ("S " ^ path)::acc + ) + in let flags = match flags with | [] -> [] @@ -65,6 +72,7 @@ let dot_merlin sctx ~dir ({ requires; flags; _ } as t) = let dot_merlin = List.concat [ [ "B " ^ (Path.reach dir ~from:remaindir) ] + ; source_dirs ; internals ; externals ; flags @@ -94,9 +102,10 @@ let merge_two a b = else No_preprocessing ; libname = - match a.libname with - | Some _ as x -> x - | None -> b.libname + (match a.libname with + | Some _ as x -> x + | None -> b.libname) + ; source_dirs = Path.Set.union a.source_dirs b.source_dirs } let merge_all = function diff --git a/src/merlin.mli b/src/merlin.mli index 3d93830e..e3d12961 100644 --- a/src/merlin.mli +++ b/src/merlin.mli @@ -5,6 +5,7 @@ type t = ; flags : (unit, string list) Build.t ; preprocess : Jbuild.Preprocess.t ; libname : string option + ; source_dirs: Path.Set.t } val merge_all : t list -> t option diff --git a/src/path.mli b/src/path.mli index 735033ef..ff33251d 100644 --- a/src/path.mli +++ b/src/path.mli @@ -37,6 +37,7 @@ val t : t Sexp.Of_sexp.t val sexp_of_t : t Sexp.To_sexp.t val compare : t -> t -> int +(** a directory is smaller than its descendants *) module Set : Set.S with type elt = t module Map : Map.S with type key = t diff --git a/test/blackbox-tests/jbuild b/test/blackbox-tests/jbuild index 88bd2a48..6317e0a8 100644 --- a/test/blackbox-tests/jbuild +++ b/test/blackbox-tests/jbuild @@ -64,3 +64,10 @@ (action (chdir test-cases/lib-available (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t)))))) + +(alias + ((name runtest) + (deps ((files_recursively_in test-cases/copy_files))) + (action + (chdir test-cases/copy_files + (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t)))))) diff --git a/test/blackbox-tests/test-cases/copy_files/jbuild b/test/blackbox-tests/test-cases/copy_files/jbuild new file mode 100644 index 00000000..a8c8bb9d --- /dev/null +++ b/test/blackbox-tests/test-cases/copy_files/jbuild @@ -0,0 +1,6 @@ +(jbuild_version 1) + +(copy_files# lexers/*.ml{,i}) + +(executables + ((names (test)))) diff --git a/test/blackbox-tests/test-cases/copy_files/lexers/jbuild b/test/blackbox-tests/test-cases/copy_files/lexers/jbuild new file mode 100644 index 00000000..51ee769b --- /dev/null +++ b/test/blackbox-tests/test-cases/copy_files/lexers/jbuild @@ -0,0 +1,3 @@ +(jbuild_version 1) + +(ocamllex (lexer1)) diff --git a/test/blackbox-tests/test-cases/copy_files/lexers/lexer1.mll b/test/blackbox-tests/test-cases/copy_files/lexers/lexer1.mll new file mode 100644 index 00000000..7d7dada0 --- /dev/null +++ b/test/blackbox-tests/test-cases/copy_files/lexers/lexer1.mll @@ -0,0 +1,6 @@ +{ +} + +rule lex = parse + | _ { true } + | eof { false } diff --git a/test/blackbox-tests/test-cases/copy_files/run.t b/test/blackbox-tests/test-cases/copy_files/run.t new file mode 100644 index 00000000..5166c1a8 --- /dev/null +++ b/test/blackbox-tests/test-cases/copy_files/run.t @@ -0,0 +1,8 @@ + $ $JBUILDER build -j1 test.exe .merlin --root . --debug-dependency-path + ocamllex lexers/lexer1.ml + ocamldep test.depends.ocamldep-output + ocamlc lexer1.{cmi,cmo,cmt} + ocamlopt lexer1.{cmx,o} + ocamlc test.{cmi,cmo,cmt} + ocamlopt test.{cmx,o} + ocamlopt test.exe diff --git a/test/blackbox-tests/test-cases/copy_files/test.ml b/test/blackbox-tests/test-cases/copy_files/test.ml new file mode 100644 index 00000000..f1c91c13 --- /dev/null +++ b/test/blackbox-tests/test-cases/copy_files/test.ml @@ -0,0 +1 @@ +include Lexer1