Skip to content

Commit

Permalink
Fix thierry-martinez#5: compatibility with merlin
Browse files Browse the repository at this point in the history
Reported by Kiran Gopinathan,
thierry-martinez#5

Merlin runs preprocessor in a reduced environment where `PATH` only
contains the directory where ocaml is (typically
`~/.opam/<switch>/bin`). This prevents ocaml from finding the
assembler (`as`).

This commit makes metapp check whether `as` is in the PATH before
calling ocaml. If it is not, it checks whether `/usr/bin/as` exists.
It it exists, `/usr/bin` is appended to PATH.

This is still quite fragile and will not work in environments where
`as` is not in `/usr/bin/`, but I do not know how to do better.
  • Loading branch information
thierry-martinez committed Jul 21, 2022
1 parent fb87acd commit 8f769e4
Show file tree
Hide file tree
Showing 2 changed files with 48 additions and 7 deletions.
5 changes: 5 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,8 @@
# Development version

- Fix #5: compatibility with merlin
(reported by Kiran Gopinathan, https://github.com/thierry-martinez/metapp/issues/5)

# Version 0.4.4, 2022-07-15

- Port to ppxlib 0.26.0
Expand Down
50 changes: 43 additions & 7 deletions dyncompile/dyncompile.ml
Original file line number Diff line number Diff line change
Expand Up @@ -23,21 +23,57 @@ let compiler : compiler =
archive_suffix = ".cma";
}

let format_process_status fmt (ps : Unix.process_status) =
match ps with
| WEXITED return_code ->
Format.fprintf fmt "return code %d" return_code
| WSIGNALED signal ->
Format.fprintf fmt "signal %d" signal
| WSTOPPED signal ->
Format.fprintf fmt "stopped %d" signal

let fix_compiler_env env =
let channels = Unix.open_process_full "as --version" env in
let (as_stdout, _, as_stderr) = channels in
let _as_stdout = In_channel.input_all as_stdout in
let _as_stderr = In_channel.input_all as_stderr in
match Unix.close_process_full channels with
| WEXITED 0 -> ()
| process_status ->
if not (Sys.file_exists "/usr/bin/as") then
failwith "No 'as' in /usr/bin!";
let index, path =
let exception Result of { index: int; path: string } in
try
env |> Array.iteri (fun index path ->
if String.starts_with ~prefix:"PATH=" path then
raise (Result { index; path }));
failwith "No PATH in env"
with Result { index; path } -> index, path in
env.(index) <- Printf.sprintf "%s:/usr/bin" path

let rec try_commands ~verbose list =
match list with
| [] -> assert false
| (command, args) :: tl ->
let command_line = Filename.quote_command command args in
if verbose then
prerr_endline command_line;
match Sys.command command_line with
| 0 -> ()
| 127 when tl <> [] -> try_commands ~verbose tl
| exit_code ->
let env = Unix.environment () in
fix_compiler_env env;
let channels = Unix.open_process_full command_line env in
let (compiler_stdout, _, compiler_stderr) = channels in
let compiler_stdout = In_channel.input_all compiler_stdout in
let compiler_stderr = In_channel.input_all compiler_stderr in
match Unix.close_process_full channels with
| WEXITED 0 -> ()
| WEXITED 127 when tl <> [] -> try_commands ~verbose tl
| process_status ->
Location.raise_errorf ~loc:!Ast_helper.default_loc
"@[Unable@ to@ compile@ preprocessor:@ command-line@ \"%s\"@ \
failed@ with@ exit-code@ %d@]@."
(String.escaped command_line) exit_code
failed@ with@ %a@]@,@[stdout: %s@]@,@[stderr: %s@]."
(String.escaped command_line) format_process_status
process_status compiler_stdout compiler_stderr

let compile (options : Options.t) (source_filename : string)
(object_filename : string) : unit =
Expand Down Expand Up @@ -96,4 +132,4 @@ let compile_and_load (options : Options.t) (structure : Parsetree.structure)
compile options source_filename object_filename;
Fun.protect (fun () -> Dynlink.loadfile object_filename)
~finally:(fun () -> Sys.remove object_filename))
~finally:(fun () -> Sys.remove source_filename)
~finally:(fun () -> (*Sys.remove source_filename*)())

0 comments on commit 8f769e4

Please sign in to comment.