From 8a4d762b290d64a779528e4c782d730a5997220c Mon Sep 17 00:00:00 2001 From: Gabe Levi Date: Fri, 6 May 2016 11:00:08 -0400 Subject: [PATCH] Support building Flow with OCaml 4.03.0 --- .travis.yml | 4 ++++ _tags | 7 ++++++- hack/fsevents/fsevents_stubs.c | 14 +++++++------- hack/procs/worker.ml | 12 +++++++++++- hack/utils/exit_status.ml | 6 +++--- hack/utils/sys_utils.ml | 7 ++++++- js/caml_hexstring_of_float.js | 7 +++++++ resources/opam/compilers/4.03.0/4.03.0/4.03.0.comp | 16 ++++++++++++++++ resources/opam/compilers/4.03.0/4.03.0/4.03.0.descr | 2 ++ src/commands/checkContentsCommand.ml | 2 +- src/commands/commandConnectSimple.ml | 4 ++-- src/commands/convertCommand.ml | 2 +- src/commands/forceRecheckCommand.ml | 2 +- src/commands/statusCommands.ml | 4 ++-- src/commands/versionCommand.ml | 2 +- src/common/flowExitStatus.ml | 8 ++++---- src/common/flowExitStatus.mli | 2 +- src/flow.ml | 4 ++-- src/server/server.ml | 2 +- src/server/serverFunctors.ml | 6 +++--- src/typing/flow_js.ml | 4 +++- 21 files changed, 84 insertions(+), 33 deletions(-) create mode 100644 js/caml_hexstring_of_float.js create mode 100644 resources/opam/compilers/4.03.0/4.03.0/4.03.0.comp create mode 100644 resources/opam/compilers/4.03.0/4.03.0/4.03.0.descr diff --git a/.travis.yml b/.travis.yml index 19e82d9..6e3f948 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,6 +24,10 @@ env: language: cpp matrix: include: + - compiler: ": Linux, ocaml 4.03.0, opam 1.2.0" + os: linux + env: OCAML_VERSION=4.03.0 OPAM_VERSION=1.2.0 + - compiler: ": Linux, ocaml 4.02.1, opam 1.2.0" os: linux env: OCAML_VERSION=4.02.1 OPAM_VERSION=1.2.0 diff --git a/_tags b/_tags index b1b4eca..4c5be6a 100644 --- a/_tags +++ b/_tags @@ -1,4 +1,9 @@ <**/*.ml*>: ocaml, warn_A, warn(-4-6-29-35-44-48-50), warn_error_A -: warn(-3-27) : warn(-27-34) +: warn(-41) +: warn(-3-27) +: warn(-3) +: warn(-3) +: warn(-3) +: warn(-3) <**/node_modules/**>: -traverse diff --git a/hack/fsevents/fsevents_stubs.c b/hack/fsevents/fsevents_stubs.c index c4427f1..3d8b277 100644 --- a/hack/fsevents/fsevents_stubs.c +++ b/hack/fsevents/fsevents_stubs.c @@ -20,13 +20,13 @@ #include #include -// Basically the ocaml headers and the mac headers are redefining the same -// types. AFAIK, this is a longstanding bug in the ocaml headers -// (http://caml.inria.fr/mantis/print_bug_page.php?bug_id=4877). Looking at the -// OS X headers, the conflicting typehints are gated with these definitions, so -// this was the easiest workaround for me. -#define _UINT64 -#define _UINT32 +// There's an issue with OCaml < 4.03.0 +// (http://caml.inria.fr/mantis/view.php?id=4877) where it would define these +// on OSX when it shouldn't. To support OCaml < 4.03.0 we can just undefine +// them +#undef ARCH_INT64_TYPE +#undef ARCH_UINT64_TYPE +#undef ARCH_INT64_PRINTF_FORMAT #include #include diff --git a/hack/procs/worker.ml b/hack/procs/worker.ml index 01a4a91..60c66d4 100644 --- a/hack/procs/worker.ml +++ b/hack/procs/worker.ml @@ -59,7 +59,17 @@ let (make_pipe: unit -> ('a, 'b) pipe) = fun () -> let ic = Unix.in_channel_of_descr descr_ic in let oc = Unix.out_channel_of_descr descr_oc in - let input() = Marshal.from_channel ic in + let input () = + (* OCaml 4.03.0 changed the behavior of Marshal.from_channel to no longer + * throw End_of_file when the pipe has closed. We can simulate that + * behavior, however, by trying to read a byte afterwards, which WILL raise + * End_of_file if the pipe has closed *) + begin try Marshal.from_channel ic + with Failure msg as e when msg = "input_value: truncated object" -> + ignore (input_byte ic); + raise e + end in + let output data = let s = Marshal.to_string data [Marshal.Closures] in let len = String.length s in diff --git a/hack/utils/exit_status.ml b/hack/utils/exit_status.ml index 2d876eb..6190aa3 100644 --- a/hack/utils/exit_status.ml +++ b/hack/utils/exit_status.ml @@ -9,7 +9,7 @@ *) type t = - | Ok + | No_error | Build_error | Build_terminated | Checkpoint_error @@ -50,7 +50,7 @@ type t = exception Exit_with of t let ec t = match t with - | Ok -> 0 + | No_error -> 0 | Build_error -> 2 | Build_terminated -> 1 | Checkpoint_error -> 8 @@ -93,7 +93,7 @@ let exit t = Pervasives.exit code let to_string = function - | Ok -> "Ok" + | No_error -> "Ok" | Build_error -> "Build_error" | Build_terminated -> "Build_terminated" | Checkpoint_error -> "Checkpoint_error" diff --git a/hack/utils/sys_utils.ml b/hack/utils/sys_utils.ml index 2f7b3a9..d55d13a 100644 --- a/hack/utils/sys_utils.ml +++ b/hack/utils/sys_utils.ml @@ -318,7 +318,12 @@ let symlink = on Windows since Vista, but until Seven (included), one should have administratrive rights in order to create symlink. *) let win32_symlink source dest = write_file ~file:dest source in - if Sys.win32 then win32_symlink else Unix.symlink + if Sys.win32 + then win32_symlink + else + (* 4.03 addds an optional argument to Unix.symlink that we want to ignore + *) + fun source dest -> Unix.symlink source dest (* Creates a symlink at / to * //-. *) diff --git a/js/caml_hexstring_of_float.js b/js/caml_hexstring_of_float.js new file mode 100644 index 0000000..bf87416 --- /dev/null +++ b/js/caml_hexstring_of_float.js @@ -0,0 +1,7 @@ +//Provides: caml_hexstring_of_float +function caml_hexstring_of_float() { + // https://github.com/ocsigen/js_of_ocaml/issues/403 + // Should be available when js_of_ocaml 2.8 is released + throw new Error('caml_hexstring_of_float: not implemented in JS'); +} + diff --git a/resources/opam/compilers/4.03.0/4.03.0/4.03.0.comp b/resources/opam/compilers/4.03.0/4.03.0/4.03.0.comp new file mode 100644 index 0000000..834e0c4 --- /dev/null +++ b/resources/opam/compilers/4.03.0/4.03.0/4.03.0.comp @@ -0,0 +1,16 @@ +opam-version: "1" +version: "4.03.0" +src: "https://github.com/ocaml/ocaml/archive/4.03.0.tar.gz" +build: [ + ["mkdir" "-p" "%{lib}%/ocaml/"] + ["./configure" "-prefix" prefix "-with-debug-runtime"] + [make "world"] + [make "world.opt"] + [make "install"] +] +packages: [ + "base-unix" + "base-bigarray" + "base-threads" +] +env: [[CAML_LD_LIBRARY_PATH = "%{lib}%/stublibs"]] diff --git a/resources/opam/compilers/4.03.0/4.03.0/4.03.0.descr b/resources/opam/compilers/4.03.0/4.03.0/4.03.0.descr new file mode 100644 index 0000000..2a88e9c --- /dev/null +++ b/resources/opam/compilers/4.03.0/4.03.0/4.03.0.descr @@ -0,0 +1,2 @@ +Official 4.03.0 release + diff --git a/src/commands/checkContentsCommand.ml b/src/commands/checkContentsCommand.ml index 950fd66..aa579e7 100644 --- a/src/commands/checkContentsCommand.ml +++ b/src/commands/checkContentsCommand.ml @@ -81,7 +81,7 @@ let main option_values root error_flags strip_root use_json verbose file () = if use_json then Errors_js.print_error_json ~root ~stdin_file stdout [] else Printf.printf "No errors!\n%!"; - FlowExitStatus.(exit Ok) + FlowExitStatus.(exit No_error) | _ -> let msg = "Unexpected server response!" in FlowExitStatus.(exit ~msg Unknown_error) diff --git a/src/commands/commandConnectSimple.ml b/src/commands/commandConnectSimple.ml index 841f3af..673eed6 100644 --- a/src/commands/commandConnectSimple.ml +++ b/src/commands/commandConnectSimple.ml @@ -110,7 +110,7 @@ let verify_cstate ic = function * it opens the socket but it doesn't read or write to it. So during * initialization, this function should time out. *) let connect_once ~tmp_dir root = - let open Result in + let (>>=) = Result.(>>=) in try Timeout.with_timeout ~timeout:1 @@ -120,7 +120,7 @@ let connect_once ~tmp_dir root = get_cstate ~timeout sockaddr ic oc end >>= fun (ic, oc, cstate) -> verify_cstate ic cstate >>= fun () -> - Ok (ic, oc) + Result.Ok (ic, oc) with | _ -> if not (server_exists ~tmp_dir root) then Result.Error Server_missing diff --git a/src/commands/convertCommand.ml b/src/commands/convertCommand.ml index 3fcd3fc..ac77eb2 100644 --- a/src/commands/convertCommand.ml +++ b/src/commands/convertCommand.ml @@ -100,7 +100,7 @@ let convert path recurse error_flags outpath = nerrs total_files successful_converts; let num_failed_conversions = total_files - successful_converts in if num_failed_conversions = 0 - then FlowExitStatus.(exit Ok) + then FlowExitStatus.(exit No_error) else begin let msg = spf "Failed to convert %d files" num_failed_conversions in FlowExitStatus.(exit ~msg Unknown_error) diff --git a/src/commands/forceRecheckCommand.ml b/src/commands/forceRecheckCommand.ml index 2991963..c6e329f 100644 --- a/src/commands/forceRecheckCommand.ml +++ b/src/commands/forceRecheckCommand.ml @@ -40,7 +40,7 @@ let force_recheck (args:args) server_flags = ServerProt.cmd_to_channel oc (ServerProt.FORCE_RECHECK files); let () = Timeout.input_value ic in - FlowExitStatus.(exit Ok) + FlowExitStatus.(exit No_error) let rec find_parent_that_exists path = if Sys.file_exists path diff --git a/src/commands/statusCommands.ml b/src/commands/statusCommands.ml index 09828cb..2a3983f 100644 --- a/src/commands/statusCommands.ml +++ b/src/commands/statusCommands.ml @@ -130,7 +130,7 @@ module Impl (CommandList : COMMAND_LIST) (Config : CONFIG) = struct if args.output_json then Errors_js.print_error_json ~root:args.root stdout [] else Printf.printf "No errors!\n%!"; - FlowExitStatus.(exit Ok) + FlowExitStatus.(exit No_error) | ServerProt.PONG -> let msg = "Why on earth did the server respond with a pong?" in FlowExitStatus.(exit ~msg Unknown_error) @@ -163,7 +163,7 @@ module Impl (CommandList : COMMAND_LIST) (Config : CONFIG) = struct prerr_endline "Warning: \ `flow --version` is deprecated in favor of `flow version`"; CommandUtils.print_version (); - FlowExitStatus.(exit Ok) + FlowExitStatus.(exit No_error) ); let root = CommandUtils.guess_root root in diff --git a/src/commands/versionCommand.ml b/src/commands/versionCommand.ml index ae50cf8..9421296 100644 --- a/src/commands/versionCommand.ml +++ b/src/commands/versionCommand.ml @@ -47,6 +47,6 @@ let main json from _root () = end else begin CommandUtils.print_version () end; - FlowExitStatus.(exit Ok) + FlowExitStatus.(exit No_error) let command = CommandSpec.command spec main diff --git a/src/common/flowExitStatus.ml b/src/common/flowExitStatus.ml index a9e23e3..100b917 100644 --- a/src/common/flowExitStatus.ml +++ b/src/common/flowExitStatus.ml @@ -1,6 +1,6 @@ type t = (* The generic 0 exit code *) - | Ok + | No_error (* Tried and failed to connect to a server due to the server still * initializing *) | Server_initializing @@ -56,12 +56,12 @@ type t = * In reality, probably no one cares about many of these exit codes. The ones * I know are definitely being watched for are: * - * Ok + * No_error * Type_error * Out_of_time *) let error_code = function - | Ok -> 0 + | No_error -> 0 | Server_initializing -> 1 | Type_error -> 2 | Out_of_time -> 3 @@ -91,7 +91,7 @@ let unpack_process_status = function | Unix.WSTOPPED n -> "stopped", n let to_string = function - | Ok -> "Ok" + | No_error -> "Ok" | Input_error -> "Input_error" | Could_not_find_flowconfig -> "Could_not_find_flowconfig" | Server_out_of_date -> "Server_out_of_date" diff --git a/src/common/flowExitStatus.mli b/src/common/flowExitStatus.mli index 1ce1d5e..7052ae3 100644 --- a/src/common/flowExitStatus.mli +++ b/src/common/flowExitStatus.mli @@ -1,5 +1,5 @@ type t = - | Ok + | No_error | Server_initializing | Type_error | Out_of_time diff --git a/src/flow.ml b/src/flow.ml index bd0adf9..2606398 100644 --- a/src/flow.ml +++ b/src/flow.ml @@ -85,7 +85,7 @@ end = struct with | CommandSpec.Show_help -> print_endline (CommandSpec.string_of_usage command); - FlowExitStatus.(exit Ok) + FlowExitStatus.(exit No_error) | CommandSpec.Failed_to_parse msg -> let msg = Utils_js.spf "%s: %s\n%s" @@ -98,4 +98,4 @@ end let _ = FlowShell.main () (* If we haven't exited yet, let's exit now for logging's sake *) -let _ = FlowExitStatus.(exit Ok) +let _ = FlowExitStatus.(exit No_error) diff --git a/src/server/server.ml b/src/server/server.ml index 95ca99d..5e2d170 100644 --- a/src/server/server.ml +++ b/src/server/server.ml @@ -47,7 +47,7 @@ struct let run_once_and_exit env = match env.ServerEnv.errorl with - | [] -> FlowExitStatus.(exit Ok) + | [] -> FlowExitStatus.(exit No_error) | _ -> FlowExitStatus.(exit Type_error) let incorrect_hash oc = diff --git a/src/server/serverFunctors.ml b/src/server/serverFunctors.ml index a4445d4..c08c0e7 100644 --- a/src/server/serverFunctors.ml +++ b/src/server/serverFunctors.ml @@ -61,7 +61,7 @@ end = struct flush oc with (* The client went away *) - | Sys_error ("Broken pipe") -> () + | Sys_error msg when msg = "Broken pipe" -> () | e -> prerr_endlinef "wakeup_client: %s" (Printexc.to_string e) end @@ -71,7 +71,7 @@ end = struct try close_out oc with (* The client went away *) - | Sys_error ("Broken pipe") -> () + | Sys_error msg when msg = "Broken pipe" -> () | e -> prerr_endlinef "close_waiting_channel: %s" (Printexc.to_string e) end @@ -124,7 +124,7 @@ end = struct let client = { ic; oc; close } in Program.handle_client genv env client with - | Sys_error("Broken pipe") -> + | Sys_error msg when msg = "Broken pipe" -> shutdown_client (ic, oc); env | e -> diff --git a/src/typing/flow_js.ml b/src/typing/flow_js.ml index 7109c68..7c4d5a4 100644 --- a/src/typing/flow_js.ml +++ b/src/typing/flow_js.ml @@ -5661,7 +5661,9 @@ and rec_unify cx trace t1 t2 = | OpenT (_, id1), OpenT (_, id2) -> merge_ids cx trace id1 id2 - | OpenT (_, id), t | t, OpenT (_, id) when ok_unify t -> + | OpenT (_, id), t when ok_unify t -> + resolve_id cx trace id t + | t, OpenT (_, id) when ok_unify t -> resolve_id cx trace id t | PolyT (params1, t1), PolyT (params2, t2)