Merge pull request #1105 from rgrinberg/1101

Fix #1101

bin/main.ml

@@ -659,32 +659,12 @@ let check_path contexts =
             name
             (hint name (String.Set.to_list contexts))
 
-let resolve_targets ~log common (setup : Main.setup) user_targets =
+type resolve_input =
-  match user_targets with
+  | Path of Path.t
-  | [] -> []
+  | String of string
-  | _ ->
+
-    let check_path = check_path setup.contexts in
+let resolve_path path ~(setup : Main.setup) =
-    let targets =
+  check_path setup.contexts path;
-      List.map user_targets ~f:(fun s ->
-        if String.is_prefix s ~prefix:"@" then begin
-          let pos, is_rec =
-            if String.length s >= 2 && s.[1] = '@' then
-              (2, false)
-            else
-              (1, true)
-          in
-          let s = String.sub s ~pos ~len:(String.length s - pos) in
-          let path = Path.relative Path.root (prefix_target common s) in
-          check_path path;
-          if Path.is_root path then
-            die "@@ on the command line must be followed by a valid alias name"
-          else if not (Path.is_managed path) then
-            die "@@ on the command line must be followed by a relative path"
-          else
-            Ok [if is_rec then Alias_rec path else Alias path]
-        end else begin
-          let path = Path.relative Path.root (prefix_target common s) in
-          check_path path;
   let can't_build path =
     Error (path, target_hint setup path);
   in
@@ -706,15 +686,30 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
     with
     | [] -> can't_build path
     | l  -> Ok l
-        end
+
-      )
+let resolve_target common ~(setup : Main.setup) s =
+  if String.is_prefix s ~prefix:"@" then begin
+    let pos, is_rec =
+      if String.length s >= 2 && s.[1] = '@' then
+        (2, false)
+      else
+        (1, true)
     in
-    if common.config.display = Verbose then begin
+    let s = String.sub s ~pos ~len:(String.length s - pos) in
-      Log.info log "Actual targets:";
+    let path = Path.relative Path.root (prefix_target common s) in
-      let targets =
+    check_path setup.contexts path;
-        List.concat_map targets ~f:(function
+    if Path.is_root path then
-          | Ok targets -> targets
+      die "@@ on the command line must be followed by a valid alias name"
-          | Error _ -> []) in
+    else if not (Path.is_managed path) then
+      die "@@ on the command line must be followed by a relative path"
+    else
+      Ok [if is_rec then Alias_rec path else Alias path]
+  end else begin
+    let path = Path.relative Path.root (prefix_target common s) in
+    resolve_path path ~setup
+  end
+
+let log_targets ~log targets =
   List.iter targets ~f:(function
     | File path ->
       Log.info log @@ "- " ^ (Path.to_string path)
@@ -724,10 +719,29 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
     | Alias_rec path ->
       Log.info log @@ "- recursive alias " ^
                       (Path.to_string_maybe_quoted path));
-      flush stdout;
+  flush stdout
+
+let resolve_targets_mixed ~log common (setup : Main.setup) user_targets =
+  match user_targets with
+  | [] -> []
+  | _ ->
+    let targets =
+      List.map user_targets ~f:(function
+        | String s -> resolve_target common ~setup s
+        | Path p -> resolve_path p ~setup) in
+    if common.config.display = Verbose then begin
+      Log.info log "Actual targets:";
+      List.concat_map targets ~f:(function
+        | Ok targets -> targets
+        | Error _ -> [])
+      |> log_targets ~log
     end;
     targets
 
+let resolve_targets ~log common (setup : Main.setup) user_targets =
+  List.map ~f:(fun s -> String s) user_targets
+  |> resolve_targets_mixed ~log common setup
+
 let resolve_targets_exn ~log common setup user_targets =
   resolve_targets ~log common setup user_targets
   |> List.concat_map ~f:(function
@@ -1230,8 +1244,8 @@ let exec =
          [p]
        | `This_abs _ ->
          [])
-      |> List.map ~f:Path.to_string
+      |> List.map ~f:(fun p -> Path p)
-      |> resolve_targets ~log common setup
+      |> resolve_targets_mixed ~log common setup
       |> List.concat_map ~f:(function
         | Ok targets -> targets
         | Error _ -> [])

test/blackbox-tests/dune.inc

@@ -103,6 +103,14 @@
    test-cases/dev-flag-1103
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name dune-build-dir-exec-1101)
+ (deps (package dune) (source_tree test-cases/dune-build-dir-exec-1101))
+ (action
+  (chdir
+   test-cases/dune-build-dir-exec-1101
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name dune-jbuild-var-case)
  (deps (package dune) (source_tree test-cases/dune-jbuild-var-case))
@@ -764,6 +772,7 @@
   (alias dep-vars)
   (alias depend-on-the-universe)
   (alias dev-flag-1103)
+  (alias dune-build-dir-exec-1101)
   (alias dune-jbuild-var-case)
   (alias dune-ppx-driver-system)
   (alias dune-project-edition)
@@ -858,6 +867,7 @@
   (alias dep-vars)
   (alias depend-on-the-universe)
   (alias dev-flag-1103)
+  (alias dune-build-dir-exec-1101)
   (alias dune-jbuild-var-case)
   (alias dune-ppx-driver-system)
   (alias dune-project-edition)

test/blackbox-tests/test-cases/dune-build-dir-exec-1101/dune

@@ -0,0 +1 @@
+(executable (name main))

test/blackbox-tests/test-cases/dune-build-dir-exec-1101/dune-project

@@ -0,0 +1 @@
+(lang dune 1.1)

test/blackbox-tests/test-cases/dune-build-dir-exec-1101/main.ml

@@ -0,0 +1 @@
+print_endline "foobar";;

test/blackbox-tests/test-cases/dune-build-dir-exec-1101/run.t

@@ -0,0 +1,2 @@
+  $ DUNE_BUILD_DIR="$PWD/_custom" dune exec ./main.exe
+  foobar