snailed
/
void-packages
2
0
Fork 0
Code Issues 1 Pull Requests 2 Actions Activity
void-packages/srcpkgs/flow/patches/ocaml-4.03-compat.patch

423 lines
15 KiB
Diff
Raw Blame History

From 8a4d762b290d64a779528e4c782d730a5997220c Mon Sep 17 00:00:00 2001
From: Gabe Levi <gabe@fb.com>
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
-<hack/utils/*.ml*>: warn(-3-27)
<hack/heap/*.ml*>: warn(-27-34)
+<hack/third-party/core/result.ml>: warn(-41)
+<hack/utils/*.ml*>: warn(-3-27)
+<src/commands/shellCompleteCommand.ml>: warn(-3)
+<src/flow.ml>: warn(-3)
+<src/services/inference/module_js.ml>: warn(-3)
+<src/typing/statement.ml>: 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 <stdio.h>
#include <pthread.h>
-// 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 <CoreFoundation/CoreFoundation.h>
#include <CoreServices/CoreServices.h>
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 <dir>/<linkname.ext> to
* <dir>/<pluralized ext>/<linkname>-<timestamp>.<ext> *)
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)
Reference in New Issue View Git Blame Copy Permalink