(copy_files ...): support external paths (#3639)

Signed-off-by: Nicolás Ojeda Bär <n.oje.bar@gmail.com>
ocaml · Jul 23, 2020 · 6c24058 · 6c24058
1 parent 13d4a2a
commit 6c24058
Show file tree

Hide file tree

Showing 4 changed files with 53 additions and 17 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -32,6 +32,9 @@ next
 
 - Add (alias ...), (mode ...) fields to (copy_fields ...) stanza (#3631, @nojb)
 
+- (copy_files ...) now supports copying files from outside the workspace using
+  absolute file names (#3639, @nojb)
+
 2.6.1 (02/07/2020)
 ------------------
 

diff --git a/src/dune/gen_rules.ml b/src/dune/gen_rules.ml
@@ -111,13 +111,17 @@ end = struct
       ; source_dirs = None
       }
     | Copy_files { files = glob; _ } ->
-      let source_dir =
+      let source_dirs =
         let loc = String_with_vars.loc glob in
         let src_glob = Expander.expand_str expander glob in
-        Path.Source.relative src_dir src_glob ~error_loc:loc
-        |> Path.Source.parent_exn
+        if Filename.is_relative src_glob then
+          Some
+            ( Path.Source.relative src_dir src_glob ~error_loc:loc
+            |> Path.Source.parent_exn )
+        else
+          None
       in
-      { merlin = None; cctx = None; js = None; source_dirs = Some source_dir }
+      { merlin = None; cctx = None; js = None; source_dirs }
     | Install i ->
       files_to_install i;
       empty_none

diff --git a/src/dune/simple_rules.ml b/src/dune/simple_rules.ml
@@ -132,40 +132,53 @@ let copy_files sctx ~dir ~expander ~src_dir (def : Copy_files.t) =
   let loc = String_with_vars.loc def.files in
   let glob_in_src =
     let src_glob = Expander.expand_str expander def.files in
-    Path.Source.relative src_dir src_glob ~error_loc:loc
+    if Filename.is_relative src_glob then
+      Path.Source.relative src_dir src_glob ~error_loc:loc |> Path.source
+    else
+      let since = (2, 7) in
+      if def.syntax_version < since then
+        Dune_lang.Syntax.Error.since loc Stanza.syntax since
+          ~what:(sprintf "%s is an absolute path. This" src_glob);
+      Path.external_ (Path.External.of_string src_glob)
   in
   let since = (1, 3) in
   if
     def.syntax_version < since
-    && not (Path.Source.is_descendant glob_in_src ~of_:src_dir)
+    && not (Path.is_descendant glob_in_src ~of_:(Path.source src_dir))
   then
     Dune_lang.Syntax.Error.since loc Stanza.syntax since
       ~what:
         (sprintf "%s is not a sub-directory of %s. This"
-           (Path.Source.to_string_maybe_quoted glob_in_src)
+           (Path.to_string_maybe_quoted glob_in_src)
            (Path.Source.to_string_maybe_quoted src_dir));
-  let src_in_src = Path.Source.parent_exn glob_in_src in
+  let src_in_src = Path.parent_exn glob_in_src in
   let pred =
-    Path.Source.basename glob_in_src |> Glob.of_string_exn loc |> Glob.to_pred
+    Path.basename glob_in_src |> Glob.of_string_exn loc |> Glob.to_pred
   in
-  if not (File_tree.dir_exists src_in_src) then
+  let exists =
+    match Path.as_in_source_tree src_in_src with
+    | None -> Path.exists src_in_src
+    | Some src_in_src -> File_tree.dir_exists src_in_src
+  in
+  if not exists then
     User_error.raise ~loc
-      [ Pp.textf "Cannot find directory: %s" (Path.Source.to_string src_in_src)
-      ];
-  if Path.Source.equal src_in_src src_dir then
+      [ Pp.textf "Cannot find directory: %s" (Path.to_string src_in_src) ];
+  if Path.equal src_in_src (Path.source src_dir) then
     User_error.raise ~loc
       [ Pp.textf
           "Cannot copy files onto themselves. The format is <dir>/<glob> where \
            <dir> is not the current directory."
       ];
   (* add rules *)
   let src_in_build =
-    let context = Context.DB.get dir in
-    Path.Build.append_source context.build_dir src_in_src
+    match Path.as_in_source_tree src_in_src with
+    | None -> src_in_src
+    | Some src_in_src ->
+      let context = Context.DB.get dir in
+      Path.Build.append_source context.build_dir src_in_src |> Path.build
   in
   let files =
-    Build_system.eval_pred
-      (File_selector.create ~dir:(Path.build src_in_build) pred)
+    Build_system.eval_pred (File_selector.create ~dir:src_in_build pred)
   in
   let targets =
     Path.Set.map files ~f:(fun file_src ->

diff --git a/test/blackbox-tests/test-cases/copy_files.t/run.t b/test/blackbox-tests/test-cases/copy_files.t/run.t
@@ -44,3 +44,19 @@ Test (alias ...) and (mode ...) fields:
 
   $ cat test3/foo.txt
   Foo
+
+Test external paths:
+
+  $ mkdir -p test4
+  $ cat >test4/dune-project <<EOF
+  > (lang dune 2.7)
+  > EOF
+  $ P=$(mktemp)
+  $ echo Hola > $P
+  $ cat >test4/dune <<EOF
+  > (copy_files $P)
+  > EOF
+  $ dune build --root test4 $(basename $P)
+  Entering directory 'test4'
+  $ cat test4/_build/default/$(basename $P)
+  Hola