From 2e2a707d4b40118d8ec5dc9fc116d8efb2c71810 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Thu, 8 Jun 2017 09:59:43 +0100 Subject: [PATCH] Automatically install executable with extension `.exe` on Windows (#123) - Automatically add exe extension when installing executables - Look for local binaries with .exe extension on Windows --- doc/jbuild.rst | 12 +++++++++ src/action.ml | 56 ++++++++++++++++++++-------------------- src/artifacts.ml | 41 ++++++++++++++++++++++------- src/artifacts.mli | 1 + src/bin.mli | 1 + src/gen_rules.ml | 2 +- src/install.ml | 20 ++++++++++++++ src/install.mli | 3 ++- src/js_of_ocaml_rules.ml | 2 +- src/main.ml | 1 + src/super_context.ml | 39 +++++++++++++++++++++++----- 11 files changed, 130 insertions(+), 48 deletions(-) diff --git a/doc/jbuild.rst b/doc/jbuild.rst index c8e3176f..e9213f9f 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -487,6 +487,18 @@ instance, to install a file ``mylib.el`` as package is not ambiguous when the first parent directory to contain a ``.opam`` file contains exactly one ``.opam`` file +Handling of the .exe extension on Windows +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Under Microsoft Windows, executables must be suffixed with +``.exe``. Jbuilder tries to make sure that executables are always +installed with this extension on Windows. + +More precisely, when installing a file via an ``(install ...)`` +stanza, if the source file has extension ``.exe`` or ``.bc``, then +Jbuilder implicitly adds the ``.exe`` extension to the destination, if +not already present. + Common items ============ diff --git a/src/action.ml b/src/action.ml index 40bf1ddf..e6ae428a 100644 --- a/src/action.ml +++ b/src/action.ml @@ -479,34 +479,34 @@ let fold_one_step t ~init:acc ~f = | Mkdir _ -> acc let rec map t ~fs ~fp = - match t with - | Run (This prog, args) -> - Run (This (fp prog), List.map args ~f:fs) - | Run (Not_found _ as nf, args) -> - Run (nf, List.map args ~f:fs) - | Chdir (fn, t) -> - Chdir (fp fn, map t ~fs ~fp) - | Setenv (var, value, t) -> - Setenv (fs var, fs value, map t ~fs ~fp) - | Redirect (outputs, fn, t) -> - Redirect (outputs, fp fn, map t ~fs ~fp) - | Ignore (outputs, t) -> - Ignore (outputs, map t ~fs ~fp) - | Progn l -> Progn (List.map l ~f:(fun t -> map t ~fs ~fp)) - | Echo x -> Echo (fs x) - | Cat x -> Cat (fp x) - | Create_file x -> Create_file (fp x) - | Copy (x, y) -> Copy (fp x, fp y) - | Symlink (x, y) -> - Symlink (fp x, fp y) - | Copy_and_add_line_directive (x, y) -> - Copy_and_add_line_directive (fp x, fp y) - | System x -> System (fs x) - | Bash x -> Bash (fs x) - | Update_file (x, y) -> Update_file (fp x, fs y) - | Rename (x, y) -> Rename (fp x, fp y) - | Remove_tree x -> Remove_tree (fp x) - | Mkdir x -> Mkdir (fp x) + match t with + | Run (This prog, args) -> + Run (This (fp prog), List.map args ~f:fs) + | Run (Not_found _ as nf, args) -> + Run (nf, List.map args ~f:fs) + | Chdir (fn, t) -> + Chdir (fp fn, map t ~fs ~fp) + | Setenv (var, value, t) -> + Setenv (fs var, fs value, map t ~fs ~fp) + | Redirect (outputs, fn, t) -> + Redirect (outputs, fp fn, map t ~fs ~fp) + | Ignore (outputs, t) -> + Ignore (outputs, map t ~fs ~fp) + | Progn l -> Progn (List.map l ~f:(fun t -> map t ~fs ~fp)) + | Echo x -> Echo (fs x) + | Cat x -> Cat (fp x) + | Create_file x -> Create_file (fp x) + | Copy (x, y) -> Copy (fp x, fp y) + | Symlink (x, y) -> + Symlink (fp x, fp y) + | Copy_and_add_line_directive (x, y) -> + Copy_and_add_line_directive (fp x, fp y) + | System x -> System (fs x) + | Bash x -> Bash (fs x) + | Update_file (x, y) -> Update_file (fp x, fs y) + | Rename (x, y) -> Rename (fp x, fp y) + | Remove_tree x -> Remove_tree (fp x) + | Mkdir x -> Mkdir (fp x) let updated_files = let rec loop acc t = diff --git a/src/artifacts.ml b/src/artifacts.ml index bd1ca95b..d774bf04 100644 --- a/src/artifacts.ml +++ b/src/artifacts.ml @@ -3,13 +3,14 @@ open Jbuild type t = { context : Context.t - ; local_bins : String_set.t + ; local_bins : Path.t String_map.t ; local_libs : Public_lib.t String_map.t } -let create context l ~f = +let create (context : Context.t) l ~f = + let bin_dir = Config.local_install_bin_dir ~context:context.name in let local_bins, local_libs = - List.fold_left l ~init:(String_set.empty, String_map.empty) + List.fold_left l ~init:(String_map.empty, String_map.empty) ~f:(fun acc x -> List.fold_left (f x) ~init:acc ~f:(fun (local_bins, local_libs) stanza -> @@ -22,7 +23,28 @@ let create context l ~f = | Some s -> s | None -> Filename.basename src in - String_set.add name acc), + let key = + if Sys.win32 && Filename.extension name = ".exe" then + String.sub name ~pos:0 ~len:(String.length name - 4) + else + name + in + let in_bin_dir = + let fn = + if Sys.win32 then + match Filename.extension src with + | ".exe" | ".bc" -> + if Filename.extension name <> ".exe" then + name ^ ".exe" + else + name + | _ -> name + else + name + in + Path.relative bin_dir fn + in + String_map.add acc ~key ~data:in_bin_dir), local_libs) | Library { public = Some pub; _ } -> (local_bins, @@ -39,9 +61,9 @@ let binary t ?hint ?(in_the_tree=true) name = if not (Filename.is_relative name) then Ok (Path.absolute name) else if in_the_tree then begin - if String_set.mem name t.local_bins then - Ok (Path.relative (Config.local_install_bin_dir ~context:t.context.name) name) - else + match String_map.find name t.local_bins with + | Some path -> Ok path + | None -> match Context.which t.context name with | Some p -> Ok p | None -> @@ -92,12 +114,11 @@ let file_of_lib t ~from ~lib ~file = assert false } -let file_of_lib t ~from name = +let file_of_lib t ~loc ~from name = let lib, file = match String.lsplit2 name ~on:':' with | None -> - Loc.fail (Loc.in_file (Path.to_string (Path.relative from "jbuild"))) - "invalid ${lib:...} form: %s" name + Loc.fail loc "invalid ${lib:...} form: %s" name | Some x -> x in (lib, file_of_lib t ~from ~lib ~file) diff --git a/src/artifacts.mli b/src/artifacts.mli index 0d6d055b..5d9861ee 100644 --- a/src/artifacts.mli +++ b/src/artifacts.mli @@ -27,6 +27,7 @@ val binary *) val file_of_lib : t + -> loc:Loc.t -> from:Path.t -> string -> string * (Path.t, fail) result diff --git a/src/bin.mli b/src/bin.mli index a14bbd54..8b2139fc 100644 --- a/src/bin.mli +++ b/src/bin.mli @@ -17,3 +17,4 @@ val best_prog : Path.t -> string -> Path.t option (** "make" program *) val make : Path.t option + diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 1e114da7..b34aeee2 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -906,7 +906,7 @@ Add it to your jbuild file to remove this warning. Path.append install_dir (Install.Entry.relative_installed_path entry ~package) in SC.add_rule sctx (Build.symlink ~src:entry.src ~dst); - { entry with src = dst }) + Install.Entry.set_src entry dst) let install_file package_path package entries = let entries = diff --git a/src/install.ml b/src/install.ml index 6cff4f60..35490568 100644 --- a/src/install.ml +++ b/src/install.ml @@ -57,11 +57,31 @@ module Entry = struct } let make section ?dst src = + let dst = + if Sys.win32 then + let src_base = Path.basename src in + let dst' = + match dst with + | None -> src_base + | Some s -> s + in + match Filename.extension src_base with + | ".exe" | ".bc" -> + if Filename.extension dst' <> ".exe" then + Some (dst' ^ ".exe") + else + dst + | _ -> dst + else + dst + in { src ; dst ; section } + let set_src t src = { t with src } + module Paths = struct let lib = Path.(relative root) "lib" let libexec = Path.(relative root) "lib" diff --git a/src/install.mli b/src/install.mli index 84102daa..deb30a63 100644 --- a/src/install.mli +++ b/src/install.mli @@ -19,13 +19,14 @@ module Section : sig end module Entry : sig - type t = + type t = private { src : Path.t ; dst : string option ; section : Section.t } val make : Section.t -> ?dst:string -> Path.t -> t + val set_src : t -> Path.t -> t val relative_installed_path : t -> package:string -> Path.t end diff --git a/src/js_of_ocaml_rules.ml b/src/js_of_ocaml_rules.ml index e5aaa7c4..db5acbd3 100644 --- a/src/js_of_ocaml_rules.ml +++ b/src/js_of_ocaml_rules.ml @@ -18,7 +18,7 @@ let in_build_dir ~ctx = let runtime_file ~sctx ~dir fname = let _lib, file = - Artifacts.file_of_lib (SC.artifacts sctx) ~from:dir + Artifacts.file_of_lib (SC.artifacts sctx) ~loc:Loc.none ~from:dir (sprintf "js_of_ocaml-compiler:%s" fname) in match file with diff --git a/src/main.ml b/src/main.ml index 9d2962bc..b9df019c 100644 --- a/src/main.ml +++ b/src/main.ml @@ -203,6 +203,7 @@ let bootstrap () = ; "--subst" , Unit subst , " substitute watermarks in source files" ] anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:"; + Clflags.debug_dep_path := true; let log = Log.create () in Future.Scheduler.go ~log (setup ~log ~workspace:{ merlin_context = Some "default"; contexts = [Default] } diff --git a/src/super_context.ml b/src/super_context.ml index d7b4965d..775c5b76 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -474,11 +474,13 @@ module Action = struct ; mutable vdeps : (unit, Action.Var_expansion.t) Build.t String_map.t } + let add_lib_dep acc lib kind = + acc.lib_deps <- String_map.add acc.lib_deps ~key:lib ~data:kind + let add_artifact ?lib_dep acc ~key result = (match lib_dep with | None -> () - | Some (lib, kind) -> - acc.lib_deps <- String_map.add acc.lib_deps ~key:lib ~data:kind); + | Some (lib, kind) -> add_lib_dep acc lib kind); match result with | Ok exp -> acc.artifacts <- String_map.add acc.artifacts ~key ~data:exp; @@ -487,7 +489,8 @@ module Action = struct acc.failures <- fail :: acc.failures; None - let ok_path x = Ok (Action.Var_expansion.Paths ([x], Concat)) + let path_exp path = (Action.Var_expansion.Paths ([path], Concat)) + let ok_path x = Ok (path_exp x) let ok_string x = Ok (Action.Var_expansion.Strings ([x], Concat)) let map_result = function @@ -512,17 +515,39 @@ module Action = struct | Some ("path" , s) -> add_artifact acc ~key (ok_path (Path.relative dir s)) | Some ("bin" , s) -> add_artifact acc ~key (A.binary (artifacts sctx) s |> map_result) - | Some ("lib" , s) - | Some ("libexec" , s) -> - let lib_dep, res = A.file_of_lib (artifacts sctx) ~from:dir s in + | Some ("lib" , s) -> + let lib_dep, res = A.file_of_lib (artifacts sctx) ~loc ~from:dir s in add_artifact acc ~key ~lib_dep:(lib_dep, dep_kind) (map_result res) + | Some ("libexec" , s) -> begin + let lib_dep, res = A.file_of_lib (artifacts sctx) ~loc ~from:dir s in + add_lib_dep acc lib_dep dep_kind; + match res with + | Error e -> + acc.failures <- e :: acc.failures; + None + | Ok path -> + if not Sys.win32 || Filename.extension s = ".exe" then begin + let exp = path_exp path in + acc.artifacts <- String_map.add acc.artifacts ~key ~data:exp; + Some exp + end else begin + let path_exe = Path.extend_basename path ~suffix:".exe" in + let dep = + Build.if_file_exists path_exe + ~then_:(Build.path path_exe >>^ fun _ -> path_exp path_exe) + ~else_:(Build.path path >>^ fun _ -> path_exp path) + in + acc.vdeps <- String_map.add acc.vdeps ~key ~data:dep; + None + end + end | Some ("lib-available", lib) -> add_artifact acc ~key ~lib_dep:(lib, Optional) (ok_string (string_of_bool (Libs.lib_is_available sctx ~from:dir lib))) (* CR-someday jdimino: allow this only for (jbuild_version jane_street) *) | Some ("findlib" , s) -> let lib_dep, res = - A.file_of_lib (artifacts sctx) ~from:dir s + A.file_of_lib (artifacts sctx) ~loc ~from:dir s in add_artifact acc ~key ~lib_dep:(lib_dep, Required) (map_result res) | Some ("version", s) -> begin