diff --git a/bin/main.ml b/bin/main.ml index 262c2f72..a4a6adee 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -34,8 +34,8 @@ let set_common c = module Main = struct include Jbuilder.Main - let setup common = - setup ?workspace_file:common.workspace_file () + let setup ?only_package common = + setup ?workspace_file:common.workspace_file ?only_package () end let create_log = Main.create_log @@ -208,7 +208,7 @@ let resolve_package_install setup pkg = let build_package common pkg = Future.Scheduler.go ~log:(create_log ()) - (Main.setup common >>= fun setup -> + (Main.setup common ~only_package:pkg >>= fun setup -> Build_system.do_build_exn setup.build_system [resolve_package_install setup pkg]) diff --git a/src/build.ml b/src/build.ml index eb9d523a..73eb6360 100644 --- a/src/build.ml +++ b/src/build.ml @@ -301,12 +301,14 @@ let symlink ~src ~dst = Path.reach ~from:(Path.parent dst) src in let dst = Path.to_string dst in - begin - match Unix.lstat dst with - | exception _ -> () - | _ -> Sys.remove dst - end; - Unix.symlink src dst) + match Unix.readlink dst with + | target -> + if target <> src then begin + Unix.unlink dst; + Unix.symlink src dst + end + | exception _ -> + Unix.symlink src dst) let touch target = create_file ~target (fun _ -> diff --git a/src/build_system.ml b/src/build_system.ml index 2a9942d4..425b6e37 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -322,13 +322,17 @@ let remove_old_artifacts t = Path.readdir dir |> List.filter ~f:(fun fn -> let fn = Path.relative dir fn in - if Path.is_directory fn then + match Unix.lstat (Path.to_string fn) with + | { st_kind = S_DIR; _ } -> walk fn - else begin + | exception _ -> let keep = Hashtbl.mem t.files fn in if not keep then Path.unlink fn; keep - end) + | _ -> + let keep = Hashtbl.mem t.files fn in + if not keep then Path.unlink fn; + keep) |> function | [] -> false | _ -> true diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 3655cdd6..8a018954 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -1789,12 +1789,27 @@ module Gen(P : Params) = struct end) end -let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) conf = +let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) + ?only_package conf = let open Future in let { Jbuild_load. file_tree; tree; jbuilds; packages } = conf in let alias_store = Alias.Store.create () in List.map contexts ~f:(fun context -> Jbuild_load.Jbuilds.eval ~context jbuilds >>| fun stanzas -> + let stanzas = + match only_package with + | None -> stanzas + | Some pkg -> + List.map stanzas ~f:(fun (dir, stanzas) -> + (dir, + List.filter stanzas ~f:(fun stanza -> + match (stanza : Stanza.t) with + | Library { public_name = Some name; _ } + | Executables { object_public_name = Some name; _ } -> + Findlib.root_package_name name = pkg + | Install { package = Some name; _ } -> name = pkg + | _ -> true))) + in let module M = Gen(struct let context = context diff --git a/src/gen_rules.mli b/src/gen_rules.mli index 45bbdec8..191c985e 100644 --- a/src/gen_rules.mli +++ b/src/gen_rules.mli @@ -3,5 +3,6 @@ open! Import val gen : contexts:Context.t list -> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *) + -> ?only_package:string -> Jbuild_load.conf -> Build_interpret.Rule.t list Future.t diff --git a/src/main.ml b/src/main.ml index 8312f6fb..51570be7 100644 --- a/src/main.ml +++ b/src/main.ml @@ -14,7 +14,8 @@ let package_install_file { packages; _ } pkg = | Some p -> Ok (Path.relative p.path (p.name ^ ".install")) let setup ?filter_out_optional_stanzas_with_missing_deps - ?workspace ?(workspace_file="jbuild-workspace") () = + ?workspace ?(workspace_file="jbuild-workspace") + ?only_package () = let conf = Jbuild_load.load () in let workspace = match workspace with @@ -33,6 +34,7 @@ let setup ?filter_out_optional_stanzas_with_missing_deps Context.create_for_opam ~name ~switch ?root ~merlin ())) >>= fun contexts -> Gen_rules.gen conf ~contexts + ?only_package ?filter_out_optional_stanzas_with_missing_deps >>= fun rules -> let build_system = Build_system.create ~contexts ~file_tree:conf.file_tree ~rules in diff --git a/src/main.mli b/src/main.mli index 36223223..ee98c170 100644 --- a/src/main.mli +++ b/src/main.mli @@ -14,6 +14,7 @@ val setup : ?filter_out_optional_stanzas_with_missing_deps:bool -> ?workspace:Workspace.t -> ?workspace_file:string + -> ?only_package:string -> unit -> setup Future.t val external_lib_deps diff --git a/src/path.ml b/src/path.ml index 35c334db..2347140e 100644 --- a/src/path.ml +++ b/src/path.ml @@ -267,6 +267,6 @@ let exists t = Sys.file_exists (to_string t) let readdir t = Sys.readdir (to_string t) |> Array.to_list let is_directory t = Sys.is_directory (to_string t) let rmdir t = Unix.rmdir (to_string t) -let unlink t = Sys.remove (to_string t) +let unlink t = Unix.unlink (to_string t) let extend_basename t ~suffix = t ^ suffix