diff --git a/CHANGES.md b/CHANGES.md index 8de6f93a9d4..b6e9e149a2e 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -12,6 +12,8 @@ Unreleased - Allow `%{version:pkg}` to work for external packages (#4104, @kit-ty-kate) +- Add `(glob_files_rec /)` for globbing files recursively (#4176, @jeremiedimino) + 2.8.2 (21/01/2021) ------------------ diff --git a/src/dune_rules/dep_conf.ml b/src/dune_rules/dep_conf.ml index ecdee627bef..46f602f2e4c 100644 --- a/src/dune_rules/dep_conf.ml +++ b/src/dune_rules/dep_conf.ml @@ -7,7 +7,10 @@ type t = | File of String_with_vars.t | Alias of String_with_vars.t | Alias_rec of String_with_vars.t - | Glob_files of String_with_vars.t + | Glob_files of + { glob : String_with_vars.t + ; recursive : bool + } | Source_tree of String_with_vars.t | Package of String_with_vars.t | Universe @@ -18,7 +21,8 @@ let remove_locs = function | File sw -> File (String_with_vars.remove_locs sw) | Alias sw -> Alias (String_with_vars.remove_locs sw) | Alias_rec sw -> Alias_rec (String_with_vars.remove_locs sw) - | Glob_files sw -> Glob_files (String_with_vars.remove_locs sw) + | Glob_files g -> + Glob_files { g with glob = String_with_vars.remove_locs g.glob } | Source_tree sw -> Source_tree (String_with_vars.remove_locs sw) | Package sw -> Package (String_with_vars.remove_locs sw) | Universe -> Universe @@ -46,7 +50,12 @@ let decode = [ ("file", sw >>| fun x -> File x) ; ("alias", sw >>| fun x -> Alias x) ; ("alias_rec", sw >>| fun x -> Alias_rec x) - ; ("glob_files", sw >>| fun x -> Glob_files x) + ; ( "glob_files" + , sw >>| fun x -> Glob_files { glob = x; recursive = false } ) + ; ( "glob_files_rec" + , let+ () = Dune_lang.Syntax.since Stanza.syntax (2, 9) + and+ x = sw in + Glob_files { glob = x; recursive = true } ) ; ("package", sw >>| fun x -> Package x) ; ("universe", return Universe) ; ( "files_recursively_in" @@ -76,9 +85,13 @@ let encode = function | Alias_rec t -> List [ Dune_lang.unsafe_atom_of_string "alias_rec"; String_with_vars.encode t ] - | Glob_files t -> + | Glob_files { glob = t; recursive } -> List - [ Dune_lang.unsafe_atom_of_string "glob_files" + [ Dune_lang.unsafe_atom_of_string + ( if recursive then + "glob_files_rec" + else + "glob_files" ) ; String_with_vars.encode t ] | Source_tree t -> diff --git a/src/dune_rules/dep_conf.mli b/src/dune_rules/dep_conf.mli index b27ba955c6a..7ce19626aa0 100644 --- a/src/dune_rules/dep_conf.mli +++ b/src/dune_rules/dep_conf.mli @@ -6,7 +6,10 @@ type t = | File of String_with_vars.t | Alias of String_with_vars.t | Alias_rec of String_with_vars.t - | Glob_files of String_with_vars.t + | Glob_files of + { glob : String_with_vars.t + ; recursive : bool + } | Source_tree of String_with_vars.t | Package of String_with_vars.t | Universe diff --git a/src/dune_rules/dep_conf_eval.ml b/src/dune_rules/dep_conf_eval.ml index 7cf755f3d72..40f2f42274d 100644 --- a/src/dune_rules/dep_conf_eval.ml +++ b/src/dune_rules/dep_conf_eval.ml @@ -8,6 +8,15 @@ let make_alias expander s = Expander.Or_exn.expand_path expander s |> Result.map ~f:(Alias.of_user_written_path ~loc) +let fold_source_dirs dir ~init ~f = + let prefix_with, dir = Path.extract_build_context_dir_exn dir in + match File_tree.find_dir dir with + | None -> init + | Some dir -> + File_tree.Dir.fold dir ~init ~traverse:Sub_dirs.Status.Set.all + ~f:(fun dir acc -> + f (Path.append_source prefix_with (File_tree.Dir.path dir)) acc) + let dep expander = function | File s -> Expander.Or_exn.expand_path expander s @@ -26,7 +35,7 @@ let dep expander = function Build_system.Alias.dep_rec ~loc:(String_with_vars.loc s) a in []) - | Glob_files s -> + | Glob_files { glob = s; recursive } -> let loc = String_with_vars.loc s in let path = Expander.Or_exn.expand_path expander s in Result.map path ~f:(fun path -> @@ -34,8 +43,20 @@ let dep expander = function Glob.of_string_exn loc (Path.basename path) |> Glob.to_pred in let dir = Path.parent_exn path in - Action_builder.map ~f:Path.Set.to_list - (File_selector.create ~dir pred |> Action_builder.paths_matching ~loc)) + let add_dir dir acc = + let+ paths = + Action_builder.paths_matching ~loc (File_selector.create ~dir pred) + and+ acc = acc in + Path.Set.fold paths ~init:acc ~f:(fun p acc -> p :: acc) + in + let+ files = + let init = Action_builder.return [] in + if recursive then + fold_source_dirs dir ~init ~f:add_dir + else + add_dir dir init + in + List.rev files) | Source_tree s -> let path = Expander.Or_exn.expand_path expander s in Result.map path ~f:(fun path -> diff --git a/test/blackbox-tests/test-cases/glob_files_rec.t/run.t b/test/blackbox-tests/test-cases/glob_files_rec.t/run.t new file mode 100644 index 00000000000..47f36aa6f54 --- /dev/null +++ b/test/blackbox-tests/test-cases/glob_files_rec.t/run.t @@ -0,0 +1,73 @@ +Tests for (glob_files_rec /). This feature is not meat to +be release as it. We plan to replace it by recursive globs for 3.0.0. + + $ cat > dune-project < (lang dune 2.9) + > EOF + + $ cat > dune < (rule + > (alias x) + > (deps (glob_files_rec foo/*.txt)) + > (action (bash "for i in %{deps}; do printf \"\$i\\n\"; done"))) + > EOF + + $ mkdir -p foo/a/b1/c + $ mkdir -p foo/a/b2/c + $ mkdir -p foo/a/b3/c + + $ touch foo/x.txt + $ touch foo/a/x.txt + $ touch foo/a/b1/c/x.txt + $ touch foo/a/b1/c/y.txt +Leave a/b2/c empty to make sure we don't choke on empty dirs. + $ touch foo/a/b3/x.txt + $ touch foo/a/b3/x.other + + $ dune build @x + bash alias x + foo/x.txt + foo/a/x.txt + foo/a/b1/c/x.txt + foo/a/b1/c/y.txt + foo/a/b3/x.txt + + $ find . -name \*.txt | dune_cmd count-lines + 10 + $ dune build @x --force 2>&1 | dune_cmd count-lines + 6 + +Check that generated files are taken into account +------------------------------------------------- + + $ cat > foo/dune < (rule + > (target gen.txt) + > (action (with-stdout-to %{target} (echo "")))) + > EOF + + $ dune build @x --force 2>&1 | grep gen.txt + foo/gen.txt + +Check that generated directories are ignored +-------------------------------------------- + + $ cat > dune < (library + > (name foo)) + > + > (rule + > (alias x) + > (deps (glob_files_rec *.cmi)) + > (action (bash "for i in %{deps}; do echo \$i; done"))) + > EOF + + $ touch foo/foo.ml + + $ dune build + + $ find _build -name \*.cmi + _build/default/.foo.objs/byte/foo.cmi + + $ dune build @x + diff --git a/test/blackbox-tests/utils/dune_cmd.ml b/test/blackbox-tests/utils/dune_cmd.ml index 8bb2fc3df9a..553240eda8c 100644 --- a/test/blackbox-tests/utils/dune_cmd.ml +++ b/test/blackbox-tests/utils/dune_cmd.ml @@ -162,6 +162,37 @@ module Sanitizer = struct let () = register name of_args run end +module Count_lines = struct + type t = + | Stdin + | File of Path.t + + let name = "count-lines" + + let count_lines ic = + let rec loop n = + match input_line ic with + | exception End_of_file -> n + | _line -> loop (n + 1) + in + loop 0 + + let of_args = function + | [] -> Stdin + | [ file ] -> File (Path.of_filename_relative_to_initial_cwd file) + | _ -> raise (Arg.Bad "Usage: dune_arg count-lines ") + + let run t = + let n = + match t with + | Stdin -> count_lines stdin + | File p -> Io.with_file_in p ~binary:false ~f:count_lines + in + Printf.printf "%d\n%!" n + + let () = register name of_args run +end + let () = let name, args = match Array.to_list Sys.argv with